Discussion :

[Pantagruel92]

Bonjour,
Je reprends, après une absence plus longue que prévue, la discussion titrée "excuter du code quand un Label perd le controle ". J'avais été aidé par Patricktoulon (et Unparia).
Il s'agit de prendre la main quand je déplace une zone de texte dans ma feuille. Or l'événement Lostfocus n'existe pas pour les TextBox.
J'ai finalement mis en place, il y a quelques jours, un module de classe, comme suggéré par Patrick.
Voici le code :
Dans le module de classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private memSh As Shape
Private WithEvents wbk As Workbook
 
Public Event GetFocus(Sh As Shape)
Public Event LostFocus(Sh As Shape)
 
 
Public Sub ShapeClic(Sh As Shape)
    FreeShape
    Set memSh = Sh
    RaiseEvent GetFocus(memSh)
End Sub
 
Private Sub FreeShape()
    If Not memSh Is Nothing Then RaiseEvent LostFocus(memSh)
    Set memSh = Nothing
End Sub
 
Private Sub Class_Initialize()
    Set wbk = ThisWorkbook
End Sub
 
Private Sub wbk_BeforeClose(Cancel As Boolean)
    FreeShape
End Sub
 
Private Sub wbk_Deactivate()
    FreeShape
End Sub
 
Private Sub wbk_SheetActivate(ByVal Sh As Object)
    FreeShape
End Sub

Dans ThisWorkbook :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private WithEvents Mouvements As Mvts_seances
Public Sub ClickShape()
    On Error Resume Next
    If Mouvements Is Nothing Then Set Mouvements = New Mvts_seances
    Mouvements.ShapeClic ActiveSheet.Shapes(Application.Caller)
End Sub
Private Sub Mouvements_LostFocus(Sh As Shape)
nom1 = Right(Sh.Name, Len(Sh.Name) - InStr(1, Sh.Name, "((") - 1)
numero = Left(nom1, InStr(1, nom1, ")") - 1)
Call heures(numero)
End Sub
Private Sub Mouvements_GetFocus(Sh As Shape)
 
'nom1 = Right(Sh.Name, Len(Sh.Name) - InStr(1, Sh.Name, "((") - 1)
'numero = Left(nom1, InStr(1, nom1, ")") - 1)
'Call heures(numero)
End Sub

Dans la procédure qui crée le textbox:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
With plansj.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                                            gauche, haut, 60, 40)
                        .Name = nom
                        .TextFrame.Characters.Text = texte_shape '
                        .TextFrame.Characters.Font.ColorIndex = couleurtexte
                        .Fill.ForeColor.RGB = couleur  'sai.Cells(sai.Cells(lig2, col2), col + 4) 'sai.Cells(lig2, col2).Interior.ColorIndex
                        .TextFrame.HorizontalAlignment = xlCenter
                        .TextFrame.VerticalAlignment = xlCenter
                        .Line.Weight = 2
                        .Line.ForeColor.RGB = RGB(0, 0, 0)
                        .OnAction = "ThisWorkbook.ClickShape"
                        '.Height = longueur
                    End With

Mon problème, maintenant : ça marche bien pratiquement tout le temps (le code souhaité s’exécute quand je clique sur la textbox), mais, de temps en temps, pour certaines textbox, ça ne marche pas : rien ne se passe, la procédure ClickShape ne s'enclenche pas. Ces textbox "rebelles" sont, à priori, logiquement identiques aux autres.
Quelqu'un aurait-il une piste de recherche? Merci d'avance.

[Pantagruel92]

Rebonjour,
Je viens de faire le test suivant. J'ai remplacé le "on error resume next" de la macro ClicShape par "on error goto 0". Quand je clique sur une des textbox "rebelles", j'ai le message d'erreur
"Erreur système &H80070057(-2147024809). Paramètre incorrect". Ca dit quelque chose à quelqu'un? Apparemment, la cause de cette erreur peut être multiple..
Merci d'avance