Gestion des événements Exit et Enter de textbox créés dynamiquement
Malheureusement, les modules de classe ne supportent pas les événements Exit, Enter, AfterUpdate et BeforeUpdate des textbox.
source
Par exemple, pour trois textbox :
Le problème de ce code, c'est qu'il n'a rien de dynamique.
Vous êtes obligés de connaitre, à l'avance, le nombre de textbox.
Je ne donne pas ici le code de Silkyroad, mais il est disponible sur le Net.
Le principe est qu'une procédure CibleFocus tourne en boucle dès le lancement de l'UserForm et déclenche les événements lors d'un changement d'ActiveControl.
Cette procédure rend la main régulièrement à l'utilisateur grâce à un DoEvents en boucle.
C'est là que le bâs blesse. Un DoEvents en boucle affole le CPU, voir ici : vba doevents problemes et solutions
On reprend donc les deux premières solutions pour les associer.
Le problème tient essentiellement en trois points :
1- la création de l'userform devient alors également dynamique
2- la suppression de ces lignes de code à la fermeture de l'Userform est faisable, mais pas évidente.
Il nous faut, en effet, rechercher la première ligne à supprimer par son contenu.
3- Risque de bug si la limite de lignes est atteinte dans le module de l'UserForm [rare]
Cette fonction, ConnectToConnectionPoint, sert à créer un lien entre un Objet VBA (source de l'événement) et une Classe (gestionnaire de l'événement).
Les événements ne sont alors que des méthodes (Sub) de la Classe auquelles on attribue un Attribute VB_UserMemId.
C'est la présence de cet attribut, dans la méthode (Sub) de la Classe, qui en fait un gestionnaire d'événement.
Les paramètres obligatoires, à passer à cette fonction, sont :
punk As stdole.Iunknown ==> Il s'agit du gestionnaire d'événement, votre instance de classe
riidEvent As GUID ==> Un identificateur global unique (cf : ICI)
fConnect As Long ==> Définit le type de connection : VRAI (-1) = établit la connection, FAUX (0) = déconnection
punkTarget As stdole.Iunknown ==> Votre objet VBA, dans notre cas, votre TextBox
pdwCookie ==> un numéro unique identifiant cette connection (valeur de retour de la fonction)
exemple d'utilisation :
On connecte, ici, l'instance de classe Me à l'objet Obj. Il est retourné une valeur de type Long dans la variable Cook.
A noter :
> La déclaration du Private Type GUID, obligatoire pour créer l'identifiant global unique
> La double déclaration au sein d'un test IF de la fonction ConnectToConnectionPoint afin de rendre ce code valide sur les systèmes 32 et/ou 64 bits.
Ce que fait la fonction :
Personnellement, je l'ai appellé : Entree, Sortie, AvantMiseAjour et ApresMiseAjour.
Chacune de ces procédures doit comporter son propre Attribute VB_UserMemId.
Voici la liste des 4 nous concernant :
Pour chacune des procédures, vous devez placer, sous la ligne de déclaration, le UserMemId correspondant. C'est cela qui va permettre à VBA de savoir quel événement doit être déclenché.
Petite manipulation à faire :
1- Coller le code suivant dans votre module de classe
2- Exportez votre module de classe (Fichier/Exporter)
3- depuis votre éditeur de texte préféré (bloc-note), ouvrez le
4- décommentez les lignes contenant Attribute VB_UserMemId
5- enregistrez
6- Importez dans votre classeur (en ayant pris soin de supprimer le précédent)
Vous disposez maintenant des 4 procédures événementielles pour votre classe de textbox.
Pour cela :
> insérez un module standard (Insertion/Module)
> Collez ce code :
Rien de bien spécial non plus, nous déclarons une variable tableau amenée à contenir un maximum de 19 contrôles, typée As cTextbox.
Ce type n'existe pas encore. Pour cela, il nous faut créer notre module de classe.
Voilà. Nous avons créé notre classe qui nous a permis de typer notre variable tableau.
Nous faisons appel à la procédure événementielle des UserForm :
Dans cette procédure, il va nous falloir alimenter notre variable tableau Publique de l'ensemble des contrôles que nous souhaitons voir réagir aux événements Entree, Sortie, etc…
Attention, vous allez voir qu'il nous faut également passer les contrôles que j'appelle "containers". En effet, la sortie d'un textbox placé à l'intérieur d'un Frame est différente de la sortie d'un textbox directement placé sur l'UserForm.
La sortie dans ce cas est contrôlée par l'événement Exit du container (Multipage, Page ou Frame) et non plus par l'Exit du TextBox.
Il nous faut donc les passer à la classe.
De plus, pour nos essais, nous allons construire, dynamiquement, des contrôles dans un UserForm.
Afin de tester plusieurs cas de figure, nous allons créer :
- des textbox directement dans l'UserForm
- des textbox dans un frame
- des textbox dans les pages d'un multipage
- des textbox dans des frame eux-mêmes situés dans d'autres frame.
Pour cela, insérez, dans un nouveau classeur, un UserForm, et placez les code suivants dans son module :
====UserForm Initialize===
Pour cela, nous allons attendre la fin d'utilisation de notre UserForm, soit son événement Terminate.
Ce qui nous donne le code :
Arrivé à ce stade, si vous essayez d'ouvrir l'UserForm, vous allez vous retrouver avec une belle erreur : la Méthode n'existe pas.
En effet, pour ajouter nos contrôles à la Classe, nous avons utilisé la méthode Add. Pour supprimer les instances de classe, nous utilisons la méthode Clear.
Or, aucune Sub ni Function, dans notre module de classe, ne porte ces noms.
Pour alimenter la variable iFocus depuis le code de la classe et pouvoir lire les propriétés iNom et iFocus, il nous faut créer des propriétés en Lecture et/ou Lecture - écriture.
Les codes :
Je ne m'étendrais pas sur ce sujet, il existe de nombreux tutos sur Internet.
Il nous faut donc maintenant définir les deux méthodes permettant l'ajout et la suppression d'instances à notre classe.
La méthode Clear va déconnecter l'objet :
Le but de ces codes va être :
> de colorer un textbox lors de l'entrée
> d'en empêcher la sortie s'il est vide.
A la base, nous disposons de ces 4 Sub (qui doivent rester Public !!!)
Les deux dernières, Avant et Apres MiseAjour ne nous intéressent pas pour l'exercice. Nous allons donc les laisser de côté.
Dans la procédure d'entrée, il nous faut :
> lui "attribuer" le focus (régler sa variable Focus = True)
> s'il s'agit d'un textbox, en colorer le fond.
Le code devient tout simplement :
Dans la procédure de Sortie, il nous faut :
Le cas du container :
Nous allons ici avoir besoin d'une procédure qui vérifie l'ActiveControl et lance la procédure événementielle.
Pour lancer la procédure événementielle du textbox ayant le focus, nous utilisons ici CallByName.
CallByName utilise comme paramètres :
> l'instance de classe devant être appelée
> le nom de la procédure à déclencher
> la méthode
> les éventuels paramètres à passer à la procédure
Il nous faut donc ici retrouver la bonne instance de classe.
Pour cela, nous allons utiliser une fonction qui boucle sur toutes les instances de classe.
Nous avons bien fait donc de déclarer notre variable tableau de contrôles en Public.
La fonction est donc la suivante :
Et voici donc, fort de ces deux méthodes, la procédure de Sortie :
Implementation of the event handling by API: ConnectToConnectionPoint :
http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays_Eng_ref.htm#C2CP
TextBox Exit & Enter :
http://codes-sources.commentcamarche.net/forum/affich-10062379-classe-de-textbox-et-evenements-exit-et-enter
Un classeur exemple est disponible au téléchargement ici : http://www.cjoint.com/c/FEtmwqoV1CE
Un exemple d'utilisation ici :
http://codes-sources.commentcamarche.net/source/101489-interface-en-vba-implements
N'hésitez pas à me contacter pour de plus amples informations.
Solutions de contournement
Il en existe plusieurs, en voici trois.Routine de validation
La première consiste à créer une routine de validation, routine appelée par autant de Sub événementielle que vous avez de textbox.source
Par exemple, pour trois textbox :
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Validation Cancel
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Validation Cancel
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Validation Cancel
End Sub
' Sub commune de validation
Private Sub Validation(Optional ByVal Cancel As MSForms.ReturnBoolean)
Dim monTextBox As MSForms.TextBox
Set monTextBox = Me.ActiveControl
If Not IsNumeric(monTextBox) Then
MsgBox "Merci de saisir une valeur numérique", vbExclamation, monTextBox.Name
Cancel = True
End If
End Sub
Le problème de ce code, c'est qu'il n'a rien de dynamique.
Vous êtes obligés de connaitre, à l'avance, le nombre de textbox.
Surveillance de l'UserForm
SourceJe ne donne pas ici le code de Silkyroad, mais il est disponible sur le Net.
Le principe est qu'une procédure CibleFocus tourne en boucle dès le lancement de l'UserForm et déclenche les événements lors d'un changement d'ActiveControl.
Cette procédure rend la main régulièrement à l'utilisateur grâce à un DoEvents en boucle.
C'est là que le bâs blesse. Un DoEvents en boucle affole le CPU, voir ici : vba doevents problemes et solutions
Création dynamique des procédures événementielles
Ici, le principe est d'écrire les codes des procédures événementielles pour chaque création de textbox.On reprend donc les deux premières solutions pour les associer.
Dim Ct As Control, j As Long, i As Integer
For i = 1 To 10
Set Ct = Usf.Controls.Add("forms.TextBox.1", "TextBox" & i, True)
With Usf.CodeModule
j = .CountOfLines
.InsertLines j + 1, "Sub TextBox" & i & "_Click()"
.InsertLines j + 2, "Validation Cancel"
.InsertLines j + 3, "End Sub"
End With
Next i
Le problème tient essentiellement en trois points :
1- la création de l'userform devient alors également dynamique
2- la suppression de ces lignes de code à la fermeture de l'Userform est faisable, mais pas évidente.
Il nous faut, en effet, rechercher la première ligne à supprimer par son contenu.
3- Risque de bug si la limite de lignes est atteinte dans le module de l'UserForm [rare]
Gestion des événements
Il existe une fonction de l'API windows permettant d'établir une connection entre un contrôle et une instance de classe.Cette fonction, ConnectToConnectionPoint, sert à créer un lien entre un Objet VBA (source de l'événement) et une Classe (gestionnaire de l'événement).
Les événements ne sont alors que des méthodes (Sub) de la Classe auquelles on attribue un Attribute VB_UserMemId.
C'est la présence de cet attribut, dans la méthode (Sub) de la Classe, qui en fait un gestionnaire d'événement.
Function ConnectToConnectionPoint
La déclaration, à placer en entête du module de Classe :Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal punk As stdole.IUnknown, _
ByRef riidEvent As GUID, _
ByVal fConnect As Long, _
ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, _
Optional ByVal ppcpOut As Long) As Long
Les paramètres obligatoires, à passer à cette fonction, sont :
punk As stdole.Iunknown ==> Il s'agit du gestionnaire d'événement, votre instance de classe
riidEvent As GUID ==> Un identificateur global unique (cf : ICI)
fConnect As Long ==> Définit le type de connection : VRAI (-1) = établit la connection, FAUX (0) = déconnection
punkTarget As stdole.Iunknown ==> Votre objet VBA, dans notre cas, votre TextBox
pdwCookie ==> un numéro unique identifiant cette connection (valeur de retour de la fonction)
exemple d'utilisation :
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal punk As stdole.IUnknown, _
ByRef riidEvent As GUID, _
ByVal fConnect As Long, _
ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, _
Optional ByVal ppcpOut As LongPtr) As Long
#Else
Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal punk As stdole.IUnknown, _
ByRef riidEvent As GUID, _
ByVal fConnect As Long, _
ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, _
Optional ByVal ppcpOut As Long) As Long
#End If
Sub Connection(Obj As Object)
Dim cGuid As GUID, C As Boolean, Cook As Long
With cGuid
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
C = True
ConnectToConnectionPoint Me, cGuid, C, Obj, Cook, 0&
End Sub
On connecte, ici, l'instance de classe Me à l'objet Obj. Il est retourné une valeur de type Long dans la variable Cook.
A noter :
> La déclaration du Private Type GUID, obligatoire pour créer l'identifiant global unique
> La double déclaration au sein d'un test IF de la fonction ConnectToConnectionPoint afin de rendre ce code valide sur les systèmes 32 et/ou 64 bits.
Ce que fait la fonction :
- Tout d'abord, recevoir un message d'événement de la source d'événements.
- Trouver le gestionnaire d'événements pour ce message d'événement.
- Réaliser le traitement relatif au gestionnaire d'événement trouvé.
Les Méthodes événementielles
Vous pouvez les nommer comme bon vous semble. Attention toutefois à conserver un nom parlant pour la maintenance de votre code.Personnellement, je l'ai appellé : Entree, Sortie, AvantMiseAjour et ApresMiseAjour.
Chacune de ces procédures doit comporter son propre Attribute VB_UserMemId.
Voici la liste des 4 nous concernant :
- Enter : &H80018202 = -2147384830
- Exit : &H80018203 = -2147384829
- BeforeUpdate : &H80018201 = -2147384831
- AfterUpdate : &H80018200 = -2147384832
Pour chacune des procédures, vous devez placer, sous la ligne de déclaration, le UserMemId correspondant. C'est cela qui va permettre à VBA de savoir quel événement doit être déclenché.
Petite manipulation à faire :
1- Coller le code suivant dans votre module de classe
Public Sub Entree()
'Attribute Entree.VB_UserMemId = -2147384830
End Sub
Public Sub Sortie(ByVal Cancel As MSForms.ReturnBoolean)
'Attribute Sortie.VB_UserMemId = -2147384829
End Sub
Public Sub AvantMiseAjour(ByVal Cancel As MSForms.ReturnBoolean)
'Attribute AvantMiseAjour.VB_UserMemId = -2147384831
End Sub
Public Sub ApresMiseAjour()
'Attribute ApresMiseAjour.VB_UserMemId = -2147384832
End Sub
2- Exportez votre module de classe (Fichier/Exporter)
3- depuis votre éditeur de texte préféré (bloc-note), ouvrez le
4- décommentez les lignes contenant Attribute VB_UserMemId
5- enregistrez
6- Importez dans votre classeur (en ayant pris soin de supprimer le précédent)
Vous disposez maintenant des 4 procédures événementielles pour votre classe de textbox.
La classe - Création
Pour réaliser ce que nous voulons faire simplement, nous avons besoin d'une variable contenant tous nos textbox et étant "lisible" aussi bien depuis le module de classe que depuis l'userform.Variable tableau publique
Nous allons donc déclarer une variable tableau, typée comme notre classe, en Public dans un module standard.Pour cela :
> insérez un module standard (Insertion/Module)
> Collez ce code :
Option Explicit
Public mesTB(18) As New cTextbox
'constantes permettant de changer la couleur de fond des textbox
Public Const COULEUR_INITIALE As Long = &H80000005
Public Const COULEUR_VISITEE As Long = &H80000003
Rien de bien spécial non plus, nous déclarons une variable tableau amenée à contenir un maximum de 19 contrôles, typée As cTextbox.
Ce type n'existe pas encore. Pour cela, il nous faut créer notre module de classe.
La classe - début du code
Insérez un nouveau module de classe, nommez le cTextbox, et placez y le type GUID ainsi que la déclaration de ConnectToConnectionPoint :Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal punk As stdole.IUnknown, _
ByRef riidEvent As GUID, _
ByVal fConnect As Long, _
ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, _
Optional ByVal ppcpOut As LongPtr) As Long
#Else
Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal punk As stdole.IUnknown, _
ByRef riidEvent As GUID, _
ByVal fConnect As Long, _
ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, _
Optional ByVal ppcpOut As Long) As Long
#End If
Voilà. Nous avons créé notre classe qui nous a permis de typer notre variable tableau.
L'UserForm - Code appelant
Vous le verrez ici, rien de spécial.Nous faisons appel à la procédure événementielle des UserForm :
Private Sub UserForm_Initialize().
Dans cette procédure, il va nous falloir alimenter notre variable tableau Publique de l'ensemble des contrôles que nous souhaitons voir réagir aux événements Entree, Sortie, etc…
Attention, vous allez voir qu'il nous faut également passer les contrôles que j'appelle "containers". En effet, la sortie d'un textbox placé à l'intérieur d'un Frame est différente de la sortie d'un textbox directement placé sur l'UserForm.
La sortie dans ce cas est contrôlée par l'événement Exit du container (Multipage, Page ou Frame) et non plus par l'Exit du TextBox.
Il nous faut donc les passer à la classe.
De plus, pour nos essais, nous allons construire, dynamiquement, des contrôles dans un UserForm.
Afin de tester plusieurs cas de figure, nous allons créer :
- des textbox directement dans l'UserForm
- des textbox dans un frame
- des textbox dans les pages d'un multipage
- des textbox dans des frame eux-mêmes situés dans d'autres frame.
Pour cela, insérez, dans un nouveau classeur, un UserForm, et placez les code suivants dans son module :
====UserForm Initialize===
'code qui se déclenche lors de l'initialisation de l'UserForm
Private Sub UserForm_Initialize()
Appel de la procédure de création dynamique des contrôles
Call Creation_Dynamique_Des_Controles
'AJOUT TEXTBOX
mesTB(0).Add Me.Controls("TextBox1")
'Pour le TextBox2 : aucune particularité
mesTB(1).Add Me.Controls("Textbox3")
mesTB(2).Add Me.Controls("TextBox4")
mesTB(3).Add Me.Controls("TextBox5")
mesTB(4).Add Me.Controls("TextBox6")
mesTB(5).Add Me.Controls("TextBox7")
'Pour le TextBox8 : aucune particularité
mesTB(6).Add Me.Controls("TextBox9")
mesTB(7).Add Me.Controls("TextBox10")
mesTB(8).Add Me.Controls("TextBox11")
mesTB(9).Add Me.Controls("TextBox12")
mesTB(10).Add Me.Controls("TextBox13")
mesTB(11).Add Me.Controls("TextBox14")
'AJOUT "CONTAINERS"
mesTB(12).Add Me.Controls("Frame1")
mesTB(13).Add Me.Controls("Frame2")
mesTB(14).Add Me.Controls("Frame3")
mesTB(15).Add Me.Controls("Frame4")
mesTB(16).Add Me.Controls("MultiPage1").Page1
mesTB(17).Add Me.Controls("MultiPage1").Page2
mesTB(18).Add Me.Controls("MultiPage1")
End Sub
Creation_Dynamique_Des_Controles
Private Sub Creation_Dynamique_Des_Controles()
Dim Ct As Control, Frm As Frame, Frm2 As Frame, Frm3 As Frame, Multi As MultiPage
Me.Move Me.Left, Me.Top, 470, 540
Set Ct = Me.Controls.Add("forms.Label.1", "Lab1", True)
Ct.Move 10, 10, 40, 20
Ct.Caption = "NOM"
Set Ct = Me.Controls.Add("forms.TextBox.1", "TextBox1", True)
Ct.Move 50, 10, 100, 20
Set Ct = Me.Controls.Add("forms.Label.1", "Lab2", True)
Ct.Move 10, 30, 40, 20
Ct.Caption = "Prénom"
Set Ct = Me.Controls.Add("forms.TextBox.1", "TextBox2", True)
Ct.Move 50, 30, 100, 20
Set Ct = Me.Controls.Add("forms.Label.1", "Lab3", True)
Ct.Move 10, 50, 40, 20
Ct.Caption = "Sécurité Soc"
Set Ct = Me.Controls.Add("forms.TextBox.1", "TextBox3", True)
Ct.Move 50, 50, 100, 20
Set Frm = Me.Controls.Add("forms.Frame.1", "Frame1", True)
With Frm
.Move 160, 10, 200, 100
.Caption = "Etat civil"
Set Ct = .Controls.Add("forms.Label.1", "Lab4", True)
Ct.Move 10, 10, 40, 20
Ct.Caption = "Date Naiss"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox4", True)
Ct.Move 50, 10, 70, 20
Set Ct = .Controls.Add("forms.Label.1", "Lab5", True)
Ct.Move 10, 30, 40, 20
Ct.Caption = "Heure"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox5", True)
Ct.Move 50, 30, 70, 20
Set Ct = .Controls.Add("forms.Label.1", "Lab6", True)
Ct.Move 10, 50, 40, 20
Ct.Caption = "VILLE"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox6", True)
Ct.Move 50, 50, 100, 20
End With
Set Ct = Me.Controls.Add("forms.CommandButton.1", "Bouton1", True)
Ct.Move 370, 10, 80, 20
Ct.Caption = "BOUTONS POUR"
Set Ct = Me.Controls.Add("forms.CommandButton.1", "Bouton2", True)
Ct.Move 370, 35, 80, 20
Ct.Caption = "TESTER SORTIE"
Set Ct = Me.Controls.Add("forms.CommandButton.1", "Bouton3", True)
Ct.Move 370, 60, 80, 20
Ct.Caption = "PAR CLIC"
Set Multi = Me.Controls.Add("forms.Multipage.1", "Multipage1", True)
With Multi
.Move 10, 120, 400, 150
With .Pages(0)
.Caption = "ADRESSE 1"
Set Ct = .Controls.Add("forms.Label.1", "Lab7", True)
Ct.Move 10, 10, 40, 20
Ct.Caption = "NUMERO"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox7", True)
Ct.Move 50, 10, 30, 20
Set Ct = .Controls.Add("forms.Label.1", "Lab8", True)
Ct.Move 10, 30, 40, 20
Ct.Caption = "RUE"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox8", True)
Ct.Move 50, 30, 300, 60
End With
With .Pages(1)
.Caption = "ADRESSE 2"
Set Ct = .Controls.Add("forms.Label.1", "Lab9", True)
Ct.Move 10, 10, 40, 20
Ct.Caption = "CODE POSTAL"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox9", True)
Ct.Move 50, 10, 50, 20
Set Ct = .Controls.Add("forms.Label.1", "Lab10", True)
Ct.Move 10, 30, 40, 20
Ct.Caption = "VILLE"
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox10", True)
Ct.Move 50, 30, 150, 20
End With
End With
Set Frm = Me.Controls.Add("forms.Frame.1", "Frame2", True)
With Frm
.Caption = "Tout numérique"
.Move 35, 300, 400, 200
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox11", True)
Ct.Move 10, 10, 240, 20
Set Frm2 = .Controls.Add("forms.Frame.1", "Frame3", True)
End With
With Frm2
.Move 10, 35, 370, 140
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox12", True)
Ct.Move 10, 10, 240, 20
Set Frm3 = .Controls.Add("forms.Frame.1", "Frame4", True)
End With
With Frm3
.Move 10, 35, 350, 100
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox13", True)
Ct.Move 10, 10, 100, 20
Set Ct = .Controls.Add("forms.TextBox.1", "TextBox14", True)
Ct.Move 10, 30, 100, 20
End With
Set Frm = Nothing
Set Frm2 = Nothing
Set Frm3 = Nothing
Set Ct = Nothing
Set Multi = Nothing
End Sub
Destruction des instances de classe
Comme nous avons créés, dans l'initialize, 19 instances de classe, il nous faut les détruire.Pour cela, nous allons attendre la fin d'utilisation de notre UserForm, soit son événement Terminate.
Ce qui nous donne le code :
Private Sub UserForm_Terminate()
Dim i As Long
For i = LBound(mesTB) To UBound(mesTB)
mesTB(i).Clear
Next i
Erase mesTB
End Sub
Arrivé à ce stade, si vous essayez d'ouvrir l'UserForm, vous allez vous retrouver avec une belle erreur : la Méthode n'existe pas.
En effet, pour ajouter nos contrôles à la Classe, nous avons utilisé la méthode Add. Pour supprimer les instances de classe, nous utilisons la méthode Clear.
Or, aucune Sub ni Function, dans notre module de classe, ne porte ces noms.
La classe - code appelé
Les variables
En dessous des déclaration de type GUID et de la Function ConnectToConnectionPoint, nous allons déclarer les 4 variables suivantes : Private iCook As Long 'valeur retournée par la connection
Private iObjet As Object 'Notre contrôle
Private iNom As String 'le nom de notre contrôle
Private iFocus As Boolean 'une variable permettant de savoir s'il a le focus ou non
Pour alimenter la variable iFocus depuis le code de la classe et pouvoir lire les propriétés iNom et iFocus, il nous faut créer des propriétés en Lecture et/ou Lecture - écriture.
Les codes :
Public Property Let Focus(booF As Boolean)
iFocus = booF
End Property
Public Property Get Focus() As Boolean
Focus = iFocus
End Property
Public Property Get Nom() As String
Nom = iNom
End Property
Je ne m'étendrais pas sur ce sujet, il existe de nombreux tutos sur Internet.
La connection
Pour créer (et détruire) nos connections, nous allons créer, en Private, une fonction de connection :Private Sub ConnectEvent(ByVal Connect As Boolean)
Dim cGuid As GUID
With cGuid
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
ConnectToConnectionPoint Me, cGuid, Connect, iObjet, iCook, 0&
End Sub
Il nous faut donc maintenant définir les deux méthodes permettant l'ajout et la suppression d'instances à notre classe.
Les méthodes d'ajout et suppression
La méthode Add permettra la connection de la classe à l'objet :Public Sub Add(ByVal Obj As Object)
Set iObjet = Obj 'variable Objet alimentée de notre contrôle (côté appelant : .Add Me.Controls("TextBox1"))
iNom = Obj.Name 'le nom de notre contrôle stocké dans son instance de classe
Call ConnectEvent(True) 'connection : True = connection
End Sub
La méthode Clear va déconnecter l'objet :
Public Sub Clear()
If (iCook <> 0) Then Call ConnectEvent(False)
Set iObjet = Nothing
End Sub
Les procédures événementielles
Leurs codes ont été donnés plus haut. N'oubliez pas les Attribute xxxxxx.VB_UserMemIdLe but de ces codes va être :
> de colorer un textbox lors de l'entrée
> d'en empêcher la sortie s'il est vide.
A la base, nous disposons de ces 4 Sub (qui doivent rester Public !!!)
Public Sub Entree()
'Attribute Entree.VB_UserMemId = -2147384830
End Sub
Public Sub Sortie(ByVal Cancel As MSForms.ReturnBoolean)
'Attribute Sortie.VB_UserMemId = -2147384829
End Sub
Public Sub AvantMiseAjour(ByVal Cancel As MSForms.ReturnBoolean)
'Attribute AvantMiseAjour.VB_UserMemId = -2147384831
End Sub
Public Sub ApresMiseAjour()
'Attribute ApresMiseAjour.VB_UserMemId = -2147384832
End Sub
Les deux dernières, Avant et Apres MiseAjour ne nous intéressent pas pour l'exercice. Nous allons donc les laisser de côté.
Dans la procédure d'entrée, il nous faut :
> lui "attribuer" le focus (régler sa variable Focus = True)
> s'il s'agit d'un textbox, en colorer le fond.
Le code devient tout simplement :
Public Sub Entree()
'Attribute Entree.VB_UserMemId = -2147384830
Focus = True
If TypeOf iObjet Is MSForms.TextBox Then iObjet.BackColor = COULEUR_VISITEE
End Sub
Dans la procédure de Sortie, il nous faut :
- différencier s'il s'agit d'un textbox ou d'un container,
- S'il s'agit d'un textbox :
- vérifier s'il est vide
- S'il l'est, empêcher la sortie
- sinon, changer sa couleur et sa variable Focus
- s'il s'agit d'un container, il faut :
- vérifier si son activeControl est un textbox
- si oui, lancer la procédure événementielle de sortie de ce textbox.
Le cas du container :
Nous allons ici avoir besoin d'une procédure qui vérifie l'ActiveControl et lance la procédure événementielle.
Private Sub Conteneur_Sortie(ByVal Cancel As MSForms.ReturnBoolean)
'le code déclenché dans "Frame_Exit" ou "MultiPage_Exit"
Dim Conteneur As Object
If TypeOf iObjet Is MSForms.MultiPage Then
Set Conteneur = iObjet.SelectedItem
Else
Set Conteneur = iObjet
End If
If Conteneur.ActiveControl Is Nothing Then Exit Sub
If TypeOf Conteneur.ActiveControl Is MSForms.TextBox Then
'lance la procédure événementielle de sortie de l'activecontrol
CallByName ItemByName(Conteneur.ActiveControl.Name), "Sortie", VbMethod, Cancel
End If
End Sub
Pour lancer la procédure événementielle du textbox ayant le focus, nous utilisons ici CallByName.
CallByName utilise comme paramètres :
> l'instance de classe devant être appelée
> le nom de la procédure à déclencher
> la méthode
> les éventuels paramètres à passer à la procédure
Il nous faut donc ici retrouver la bonne instance de classe.
Pour cela, nous allons utiliser une fonction qui boucle sur toutes les instances de classe.
Nous avons bien fait donc de déclarer notre variable tableau de contrôles en Public.
La fonction est donc la suivante :
Private Function ItemByName(Nom As String) As cTextbox
Dim i As Integer
For i = LBound(mesTB) To UBound(mesTB)
If mesTB(i).Nom = Nom Then
Set ItemByName = mesTB(i): Exit Function
End If
Next i
End Function
Et voici donc, fort de ces deux méthodes, la procédure de Sortie :
Public Sub Sortie(ByVal Cancel As MSForms.ReturnBoolean)
'Attribute Sortie.VB_UserMemId = -2147384829
If TypeOf iObjet Is MSForms.MultiPage Or TypeOf iObjet Is MSForms.Page Or TypeOf iObjet Is MSForms.Frame Then
Call Conteneur_Sortie(Cancel)
Else
If iObjet.Text = "" Then Cancel = True
End If
Focus = CBool(Cancel)
If Not Focus Then
If TypeOf iObjet Is MSForms.TextBox Then iObjet.BackColor = COULEUR_INITIALE
End If
End Sub
Conclusion
Mes sources :Implementation of the event handling by API: ConnectToConnectionPoint :
http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays_Eng_ref.htm#C2CP
TextBox Exit & Enter :
http://codes-sources.commentcamarche.net/forum/affich-10062379-classe-de-textbox-et-evenements-exit-et-enter
Un classeur exemple est disponible au téléchargement ici : http://www.cjoint.com/c/FEtmwqoV1CE
Un exemple d'utilisation ici :
http://codes-sources.commentcamarche.net/source/101489-interface-en-vba-implements
N'hésitez pas à me contacter pour de plus amples informations.
A voir également
- Gestion des événements Exit et Enter de textbox créés dynamiquement
- Java gestion des évenements (Résolu) » Forum - Java
- Gestion des évènements (Résolu) » Forum - VB / VBA
- Arrêter la gestion des évènements (Résolu) » Forum - VB / VBA
- Associer un evenement au bouton Enter » Forum - Windows
- Logiciel météo et gestion d'événements [Résolu] » Forum - Comptabilité / Gestion
Publié par pijaku.