[VBA-E 2000]Evènement Enter sur TextBox créé dynamiquement

Version imprimable

22/03/2007, 10h43
spileo

[VBA-E 2000]Evènement Enter sur TextBox créé dynamiquement
Bonjour.

J'ai un classeur qui crée un TextBox sur une UserForm de manière dynamique.
Le TextBox est déclaré comme ceci:
Code:

1 2 Public WithEvents TxtD As MSForms.TextBox
Une fois créé, mon contrôle s'appelle TextBox1
J'arrive à piéger l'évènement Change de ce TextBox, mais pas l'évènement Enter.
Voici la procédure qui me permet de piéger l'évènement Enter.
Code:

1 2 3 4 Private Sub TextBox1_Enter() MsgBox "Ok" End Sub
Celle qui me permet de piéger l'évènement Change est:
Code:

1 2 3 4 Private Sub TextBox1_Change() MsgBox "Contenu" End Sub
Ce qui me paraît étrange c'est que lorsqu'on crée un TextBox manuellement, dans les listes déroulantes qui permettent de sélectionner un contrôle et les procédures associées, apparaît la procédure Enter (en gras si elle a été écrite et en normal sinon), tout comme la procédure Change ou DblClick.

Quand on crée un TextBox de manière dynamique, certaines de ces procédures disparaissent des barres d'outil et c'est le cas de Enter, ce qui ne me rend pas très optimiste pour la suite de mon problème.

Quelqu'un a-t-il déjà eu le problème?
Merci.
22/03/2007, 14h03
ouskel'n'or
Ce qui me paraît étrange, c'est que tu aies effectivement un événement sur Textbox1...
Essaie de créer la macro
Code:

1 2 3 Private Sub TxtD_Enter() MsgBox "Ok" End Sub
Tu dis ;)

Effectivement c'était plutôt étrange et pour tout dire ça risquait pas de marcher.
Néanmoins j'ai essayé avec ce code:

Code:

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
34
35
 
Option Explicit
Public WithEvents TB As MSForms.TextBox
Public WithEvents L As MSForms.Label
Public WithEvents B As MSForms.CommandButton
 
Private Sub UserForm_Initialize()
    Set TB = UserForm1.Controls.Add("Forms.TextBox.1")
    Set L = UserForm1.Controls.Add("Forms.Label.1")
    Set B = UserForm1.Controls.Add("Forms.CommandButton.1")
    L.BackColor = &H80000005
    L.Left = TB.Width
    B.Left = L.Left + L.Width
 
End Sub
 
Private Sub B_Click()
    MsgBox "clic"
End Sub
 
Private Sub L_Click()
    MsgBox "vlic"
End Sub
 
Private Sub TB_exit(ByVal cancel As Boolean)
    MsgBox "tu sors"
End Sub
 
Private Sub TB_Change()
    MsgBox "change"
End Sub
 
Private Sub TB_enter()
    MsgBox "entrée"
End Sub

Certains évènements fonctionnent et pas d'autres: le clic sur le CommandButton est ok, sur le Label aussi, le Change du TextBox fonctionne mais ni le Enter ni le Exit du TextBox ne sont détectés.
Merci Ouskel'n'or.

22/03/2007, 17h47
SilkyRoad

bonsoir

Je vais peut être dire une grosse bétise mais il me semble que l'évènement Enter (tout comme BeforeUpdate, AfterUpdate et Exit) n'est pas associé à MSForms.TextBox mais à MSForms.Control. C'est pour ça qu'il n'est pas disponible pour ton objet créé dynamiquement.

bonne soirée
michel
22/03/2007, 17h59
ouskel'n'or

Ben moi j'ai moins bien que toi, sur la ligne

Citation:

Public WithEvents TB As MSForms.TextBox

j'ai le message "L'objet n'est pas source d'événement automation" (???) :cry:
22/03/2007, 18h11
spileo
Bonsoir,
j'aurais bien aimé que ce soit ça mais apparemment c'était une fausse piste.
J'ai déclaré mon TextBox comme ceci pour voir:
Code:

1 2 Public WithEvents TB As MSForms.Control
Au moment ou la UserForm se charge, l'erreur suivante se produit:
"L'objet ou la classe ne gère pas le jeu d'évènements".
J'ai bien vérifié dans l'aide et il semble bien que cet évènement s'applique au TextBox.
Je vais essayer avec LostFocus.
Merci et bonne soirée.

1 pièce(s) jointe(s)

Bonjour.
En fait ce n'est pas l'évènement LostFocus qui convient pour un TextBox, c'est BeforeUpdate ou AfterUpdate. Mais même en utilisant ces évènements ça ne fonctionne pas: je n'arrive pas à les piéger lorsque les contrôles sont créés de manière dynamique.

Mais voici le fond du problème:

J'ai deux classeurs: un classeur de code et un classeur de résultats créé par mon classeur de code lorsque le code du classeur de code s'exécute.

Voici comment se déroule l'exécution du code de mon classeur de code:
1-On remplit des cellules dans mon classeur de résultats et on y insère des formules.
2-Le classeur de code écrit dans le module de code d'une Userform nommée "SaisieDonnees" de mon classeur de résultats la procédure "UserForm_Initialize" et quelques autres procédures évènementielles nécessaires au fonctionnement du programme comme le contrôle de ce que saisit l'utilisateur dans les TextBox de ma UserForm "SaisieDonnees", que je vais détailler après.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Option Explicit Public WithEvents Lbl As MSForms.Label Public WithEvents TxtBx As MSForms.TextBox Public WithEvents b As MSForms.CommandButton Private Sub Userform_Initialize() Set Lbl = SaisieDonnees.Controls.Add("Forms.Label.1") Lbl.ForeColor = &H8000000D Set TxtBx = SaisieDonnees.Controls.Add("Forms.TextBox.1") TxtBx.ControlSource = Application.Workbooks("Classeur16").Worksheets("Feuil1").Range("Ray").Address TxtBx.Left = Lbl.Width Set b = SaisieDonnees.Controls.Add("Forms.CommandButton.1") b.Caption = "Quitter" b.Left = Lbl.Width + TxtBx.Width SaisieDonnees.Width = TxtBx.Width + Lbl.Width + b.Width SaisieDonnees.Height = 60 SaisieDonnees.Caption = "Calculs" Lbl.Caption = "Rayon" Lbl.TextAlign = 2 End Sub
3-le classeur de code écrit dans un module de code "Module1" de mon classeur de résultats la procédure "Lancement".
Code:

1 2 3 4 5 6 Sub Lancement() SaisieDonnees.Show Application.DisplayAlerts = False Application.Workbooks("Classeur16").Close End Sub
4-l'affichage de ma UserForm est lancé depuis mon classeur de code grâce à la commande:
Code:

1 2 Application.Run (ClasseurRes.Name & "!Lancement")
Cette UserForm créée dynamiquement est liée à une feuille de calcul de mon classeur de resultats grâce à la propriété ControlSource d'un TextBox.

Elle est destinée à afficher le diamètre, le rayon ou la surface d'un disque.

Sur ma UserForm j'ai donc un Label qui indique quel paramètre (Diamètre ou rayon ou surface) on est en train de saisir et un TextBox dans lequel on effectue la saisie.

Un clic sur le Label doit faire changer son Caption de la façon suivante: si le caption était "Rayon", on le change pour "Diamètre". S'il était "Diamètre' on le change pour "Surface" est s'il était "Surface", on le change pour "Rayon". Et dans le même temps, on fait changer la propriété ControlSource du TextBox de B1 à B2 dans le premier cas et de B2 à B3 dans le second et de B3 à B1 dans le dernier cas.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub Lbl_Click() If Lbl.Caption = "Rayon" Then Lbl.Caption = "Diamètre" TxtBx.ControlSource = Application.Workbooks("Classeur16").Worksheets("Feuil1").Range("Dia").Address ElseIf Lbl.Caption = "Diamètre" Then Lbl.Caption = "Surface" TxtBx.ControlSource = Application.Workbooks("Classeur16").Worksheets("Feuil1").Range("Sur").Address ElseIf Lbl.Caption = "Surface" Then Lbl.Caption = "Rayon" TxtBx.ControlSource = Application.Workbooks("Classeur16").Worksheets("Feuil1").Range("Ray").Address End If End Sub
En mettant des formules dans ma feuille Excel et une valeur par défaut pour le rayon, je calcule le diamètre et la surface correspondant.

Si bien que lorsque ma UserForm s'affiche pour la première fois et que je clique sur le Label j'obtiens bien tout ce que je veux: diamètre, surface et rayon.

Mais maintenant je veux changer le rayon, et je veux que Excel recalcule tout.
Pour cela je piège l'évènement Change du TextBox. Quand il se produit, je teste ce qui est saisi: on n'autorise que les nombres. Puis je viens écrire dans la case C1 de ma feuille quel paramètre à été saisi: diamètre, surface ou rayon.
Code:

1 2 3 4 5 6 Private Sub TxtBx_Change() Application.Calculation = xlCalculationManual Application.Workbooks("Classeur16").Worksheets("Feuil1").Cells(1, 3).Value = Lbl.Caption Application.Run ("EcritureDynamique2.xls!Formules") End Sub
et je réécris les formules qui sont nécessaires au calcul en fonction de ce qui se trouve dans C1: c'est la procédure "Formules" située dans mon classeur de code mais appelée depuis mon classeur de résultats:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Formules() Application.Calculation = xlCalculationManual If Application.ActiveWorkbook.Worksheets.Item(1).Cells(1, 3).Value = "Rayon" Then Application.ActiveWorkbook.Worksheets.Item(1).Range("Dia").FormulaLocal = "=2*Ray" Application.ActiveWorkbook.Worksheets.Item(1).Range("Sur").FormulaLocal = "=PI()*(Ray^2)" ElseIf Application.ActiveWorkbook.Worksheets.Item(1).Cells(1, 3).Value = "Diamètre" Then Application.ActiveWorkbook.Worksheets.Item(1).Range("Ray").FormulaLocal = "=Dia/2" Application.ActiveWorkbook.Worksheets.Item(1).Range("Sur").FormulaLocal = "=PI()*(Dia^2)/4" ElseIf Application.ActiveWorkbook.Worksheets.Item(1).Cells(1, 3).Value = "Surface" Then Application.ActiveWorkbook.Worksheets.Item(1).Range("Ray").FormulaLocal = "=(Sur/PI())^(0.5)" Application.ActiveWorkbook.Worksheets.Item(1).Range("Dia").FormulaLocal = "=(4*Sur/PI())^(0.5)" End If Application.ActiveWorkbook.Worksheets.Item(1).Calculate End Sub
Si c'est la surface, alors pour la cellule rayon on rentre la formule racine(surface/pi). Si c'est le diamètre, alors on écrit diamètre/2, etc.

Le problème est que pour pouvoir saisir quoi que ce soit, je suis obligé de désactiver le calcul automatique d'Excel quand on arrive à la procédure Change du TextBox sinon le contenu du Textbox change continuellement et notamment lorsqu'une formule est entrée et je ne sais pas quand réactiver l'option automatique de calcul ou même faire un Worksheet.Calculate vu que je ne parviens pas à faire marcher les évènements Exit et AfterUpdate du TextBox créé dynamiquement. Voilà. J'espère avoir été un peu plus clair.
Je mets en pièce jointe mon classeur de code.
Si vous avez une version autre qu'Excel 2000 ou un chemin d'installation différent du mien, il vous faudra sans doute rajouter la référence Microsoft Visual Basic for Applications Extensibility 5.3.
Merci.

bonjour

Voici un exemple pour gérer les évènements Focus et Exit sur les contrôles créés dynamiquement:

Code:

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
'---- dans un module de classe nommé Classe1
Option Explicit
 
Public Event GetFocus()
Public Event LostFocus(ByVal Txtbx As String)
Public nomObjActif As String
 
 
Public Sub cibleFocus(USF As MSForms.UserForm)
With USF
        If TypeName(.ActiveControl) = "TextBox" Then
            nomObjActif = .ActiveControl.Name
            On Error GoTo errorHandler
            Do
                DoEvents
                If .ActiveControl.Name <> nomObjActif Then
                    'If TypeName(.ActiveControl) = "TextBox" Then
                        RaiseEvent LostFocus(nomObjActif)
                        nomObjActif = .ActiveControl.Name
                        RaiseEvent GetFocus
                    'End If
                End If
            Loop
            End If
End With
 
errorHandler:
Exit Sub
End Sub

Code:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
'---  dans l'UserForm  ---
Option Explicit
Private WithEvents USF As Classe1
 
Dim TB As Control
 
 
 
Private Sub UserForm_Initialize()
    Dim L As Control
    Dim B As Control
 
    Set TB = UserForm1.Controls.Add("Forms.TextBox.1")
    Set L = UserForm1.Controls.Add("Forms.Label.1")
    Set B = UserForm1.Controls.Add("Forms.CommandButton.1")
    L.BackColor = &H80000005
    L.Left = TB.Width
    B.Left = L.Left + L.Width
End Sub
 
 
 
Private Sub UserForm_Activate()
    Set USF = New Classe1
 
    TB.SetFocus
    Me.Controls(Me.ActiveControl.Name). _
        Object.BackColor = RGB(200, 200, 200)
 
    USF.cibleFocus Me
End Sub
 
 
 
Private Sub USF_GetFocus()
    If TypeName(Me.Controls(Me.ActiveControl.Name)) = "TextBox" Then Me.Controls(Me.ActiveControl.Name). _
        Object.BackColor = RGB(200, 200, 200)
End Sub
 
 
 
Private Sub USF_LostFocus(ByVal Txtbx As String)
    Me.Controls(Txtbx).BackColor = RGB(255, 255, 255)
End Sub
 
 
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set USF = Nothing
End Sub

michel

24/03/2007, 18h12
spileo

Merci tout le monde, ça marche très bien. Bonne fin de week end.
A+.

Bonsoir,

je pensais le problème résolu mais y'a un hic.

J'ai intégré le code de SilkyRoad (merci encore) dans un UserForm où il y a 3 TextBox, le but étant de détecter de quel TextBox créé dynamiquement l'utilisateur vient de sortir.

Le problème est que lorsque 2 TextBox ont la même valeur c'est sur le premier des deux TextBox qui ont la même valeur que le code détecte l'évènement Exit alors que ce devrait être le second.

Voici mon code:

Code:

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
34
35
 
'---  dans l'UserForm  nommé UserForm1---
Option Explicit
Private WithEvents USF As Classe1
'Public WithEvents TB1 As MSForms.TextBox
'Public WithEvents TB2 As MSForms.TextBox
'Public WithEvents TB3 As MSForms.TextBox
Dim TB1 As Control
Dim TB2 As Control
Dim TB3 As Control
Private Sub UserForm_Initialize()
    Set TB1 = UserForm1.Controls.Add("Forms.TextBox.1")
    Set TB2 = UserForm1.Controls.Add("Forms.TextBox.1")
    Set TB3 = UserForm1.Controls.Add("Forms.TextBox.1")
    TB2.Left = TB1.Left + TB1.Width
    TB3.Left = TB2.Left + TB2.Width
End Sub
Private Sub UserForm_Activate()
    Set USF = New Classe1
    TB1.SetFocus
    USF.cibleFocus Me
End Sub
Private Sub USF_LostFocus(ByVal Txtbx As String)
    Select Case Me.Controls(Txtbx)
    Case Is = TB1
        MsgBox "TB1"
    Case Is = TB2
        MsgBox "TB2"
    Case Is = TB3
        MsgBox "TB3"
    End Select
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set USF = Nothing
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
'---- dans un module de classe nommé Classe1
Option Explicit
Public Event GetFocus()
Public Event LostFocus(ByVal Txtbx As String)
Public NomObjActif As String
Public Sub cibleFocus(USF As MSForms.UserForm)
    With USF
        If TypeName(.ActiveControl) = "TextBox" Then
            NomObjActif = .ActiveControl.Name
            On Error GoTo errorHandler
            Do
                DoEvents
                If .ActiveControl.Name <> NomObjActif Then
                        RaiseEvent LostFocus(NomObjActif)
                        NomObjActif = .ActiveControl.Name
                        RaiseEvent GetFocus
                End If
            Loop
        End If
    End With
 
errorHandler:     Exit Sub
End Sub

Si quelqu'un avait une idée je serais ravi.
Merci et bonne soirée.

Bonsoir,
j'ai modifié un peu le code et maintenant ça marche mieux.
C'était principalement au niveau du LostFocus que ça n'allait pas.
Apparemment, ça ça n'allait pas
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub USF_LostFocus(ByVal Txtbx As String) Select Case Me.Controls(Txtbx) Case Is = TB1 MsgBox "TB1" Case Is = TB2 MsgBox "TB2" Case Is = TB3 MsgBox "TB3" End Select End Sub
et ça va mieux:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub USF_LostFocus(ByVal Txtbx As String) Select Case Txtbx Case Is = TB1.Name MsgBox "TB1" Case Is = TB2.Name MsgBox "TB2" Case Is = TB3.Name MsgBox "TB3" End Select End Sub Private Sub USF_GetFocus() Me.Controls(Me.ActiveControl.Name).SetFocus End Sub
Cependant je voudrais encore améliorer un peu le code pour qu'il consomme moins de CPU. En fait, il faudrait que le programme détecte un évènement sur la UserForm que tous les dixièmes de seconde par exemple.
J'ai essayé d'insérer ça à différents endroits mais sans résultat:
Code:

1 2 3 4 5 6 7 Dim PauseTime, Start PauseTime = 1 ' Définit la durée. Start = Timer ' Définit l'heure de début. Do While Timer < Start + PauseTime DoEvents ' Donne le contrôle à d'autres processus. Loop
Je n'ai pas essayé avec Wait, mais je vais chercher.
A+.