Cette démo emploi, comme le titre l'indique, des collections différentes.
Elle ne comporte que deux séries de cinq contrôles mais peut en gérer beaucoup plus avec le même nombre de lignes de code.
Elles permettent de gérer des séries de contrôles uniquement avec leurs index, que ce soit pour les événements des contrôles ou pour leurs propriétés. Pour ceux qui connaissent VB6, exactement comme les contrôles indexés.
Les collections de classes pour gérer les événements.
Les collections d'objet pour gérer les propriétés.
Les événements sont directement renvoyer dans l'Userform où les contrôles peuvent alors êtres traités directement par leur index.
La propriété contrôle.TAG est utilisée pour indiquer l'index du contrôle.
Les contrôles sur une feuille de calcul
Les collections peuvent aussi êtres employées pour des contrôles situés sur des feuilles Excel, mais ils ne disposent pas de la propriété contrôle.TAG, il est possible de remédier à cet inconvénient en utilisant la propriété contrôle. Name.
Ajouter en fin du nom du contrôle, par exemple pour index 1 >> 01, qu'importe le nom, il y aurait donc, en supposant que ce soit un TextBox nommé TxtNom deviendrait TxtNom01, TxtPrenom deviendrait TxtPrenom02, etc. Jusque 99. Si plus de 99 contrôles de la même série ajouter une 3ième valeur en commençant par 001.. Jusque 999 et tester les 3 dernier caractères du nom.
Et pour déterminer l'index (quand il est question de Tag dans les démo), employer Val(Right(Groupe.name, 2)). (ou 3 pour aller jusqu'à 999)
Attention, quelques variantes pour initialiser les contrôles dans une feuille, Voir cette astuce pour initialiser les contrôles dans une feuille
L'Userform
La démo ci-dessous marque les contrôles survolés en modifiant leurs propriétés.
Il fallait bien que je trouve un support pour mettre ces collections en pratique.
Ajouter la référence « Microsoft Forms X.X Object Library » si elle n'est pas présente.
Dans un Userform nommé « UF_DemoCC »
LA FORME
Coller 5 boutons (qu'importe le nom) avec Tag=1, =2, =3, =4, =5
Coller un 6ième bouton, Tag = 11, Caption = Quitter la démo
Coller 5 Labels, idem pour les tag de 1 à 5
Le code de l'UserForm
Option Explicit
'------------------------------------
'Déclaration des collections
Dim CollectBouton As Collection
Dim CollectLabel As Collection
Dim ClLabel
Dim ClBouton
'------------------------------------
'Déclaration pour les instances de classe
Dim mBouton As CL_DemoCC
Dim mLabel As CL_DemoCC
'------------------------------------
Dim MemIndex As Integer
Private Sub UserForm_Initialize()
Dim Ctl As Control
'--------------------------------------------------------
'Crée les collection de classe
Set CollectBouton = New Collection
Set CollectLabel = New Collection
'--------------------------------------------------------
'Crée les collections d'objet
Set ClBouton = New Collection
Set ClLabel = New Collection
'--------------------------------------------------------
For Each Ctl In Me.Controls
'verifie s'il s'agit d'un bouton
If TypeOf Ctl Is MSForms.CommandButton Then
'Ajoute dans la collection des classes boutons
Set mBouton = New CL_DemoCC
Set mBouton.GroupBoutons = Ctl
CollectBouton.Add mBouton
'Ajoute dans la collection des Objets boutons
ClBouton.Add Ctl
ElseIf TypeOf Ctl Is MSForms.Label Then
'Ajoute dans la collection des classes labels
Set mLabel = New CL_DemoCC
Set mLabel.GroupLabels = Ctl
CollectLabel.Add mLabel
'Ajoute dans la collection des Objets labels
ClLabel.Add Ctl
End If
Next Ctl
End Sub
Public Sub BoutonMouseMove(ByVal Index As Integer, Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Evite de réinitialiser si l'index n'a pas changé.
'6 c'est pour le bouton QUITTE qui n'a pas de label associé.
If MemIndex = Index Or Index = 6 Then Exit Sub
Remet
'Marque les contrôles survolé par le pointeur de souris
ClLabel(Index).SpecialEffect = 1
ClLabel(Index).ForeColor = &HFFFF&
ClBouton(Index).BackStyle = 0
ClBouton(Index).ForeColor = &H8080FF
MemIndex = Index
End Sub
'Réinitialise les contrôles sélectionnés en mode d'origine
Sub Remet()
If MemIndex = 0 Then Exit Sub
ClLabel(MemIndex).SpecialEffect = 0
ClLabel(MemIndex).ForeColor = &HFFFF00
ClBouton(MemIndex).BackStyle = 1
ClBouton(MemIndex).ForeColor = &HFFFF&
End Sub
Sub BoutonClick(ByVal Index As Integer)
If Index = 6 Then 'Bouton QUITTE LA DEMO
Unload Me
Else
Transfer(1) = ClBouton(Index).Name
Transfer(2) = ClBouton(Index).Caption
Transfer(3) = Index
Transfer(4) = ClLabel(Index).Name
Transfer(5) = ClLabel(Index).Caption
Transfer(6) = "Bouton"
`Eventuellement un UF d'affichage joint dans la démo mais pas dans cet exemple
` Affiche.Show
End If
End Sub
Sub LabelClick(ByVal Index As Integer)
Transfer(1) = ClLabel(Index).Name
Transfer(2) = ClLabel(Index).Caption
Transfer(3) = Index
Transfer(4) = ClBouton(Index).Name
Transfer(5) = ClBouton(Index).Caption
Transfer(6) = "Label"
`Eventuellement un UF d'affichage joint dans la démo mais pas dans cet exemple
` Affiche.Show
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Remet
MemIndex = 0
End Sub
Le module de classe
Dans un Module de classe nommé « CL_DemoCC »
Le code
Option Explicit
Public WithEvents GroupBoutons As MSForms.CommandButton
Public WithEvents GroupLabels As MSForms.Label
Private Sub GroupBoutons_Click()
Call UF_DemoCC.BoutonClick(GroupBoutons.Tag)
End Sub
Private Sub GroupBoutons_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Pour exemple
' Call UF_DemoCC.BoutonMouseDown(GroupLabels.Tag, Button, Shift, X, Y)
End Sub
Private Sub GroupBoutons_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call UF_DemoCC.BoutonMouseMove(GroupBoutons.Tag, Button, Shift, X, Y)
End Sub
Private Sub GroupLabels_Click()
Call UF_DemoCC.LabelClick(GroupLabels.Tag)
End Sub
Private Sub GroupLabels_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
Private Sub GroupLabels_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call UF_DemoCC.BoutonMouseMove(GroupLabels.Tag, Button, Shift, X, Y)
End Sub End Sub
Private Sub GroupLabels_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
`Ne sert pas, juste comme exemple.
End Sub
Private Sub GroupLabels_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call UF_DemoCC.GroupMouseMove(GroupLabels.Tag, Button, Shift, X, Y)
End Sub
Le module public
Dans un module général.
Option Explicit
Public Transfer(6)
Téléchargement
Vous pouvez télécharger les deux démos.
Démo 1
Utilisation de deux collections de Classe pour les événements des contrôles.
Utilisation de deux collections d'objets pour les propriétés des contrôles.
Remarque importante :
Les index dans les collections d'objet ne sont pas déterminés par le .Tag mais
par leur ORDRE DE CREATION sur la forme.
Vous devez donc en tenir compte quand vous faite le design de la forme.
Pour des contrôles gérer par une clé voir la deuxième démo.
Serveur 1 : Collections 1.xls Serveur réserve : Collections 1.xls
Démo 2
Pour cette démo j'ai utilisé la propriété Key, il n'est donc pas nécessaire de tenir compte de l'ordre de création des contrôles.
Un inconvéniant : Key DOIT être en string,
Il faut donc transcrire les index en string, heureusement, VB fait ça pour nous
sauf en cas de calcul, par exemple si index est en string Index + 5 va bien être calculé mais
le résultat sera un nombre, il faut donc mettre Cstr(Index + 5)
Pour démontrer cette possibilité j'ai mis les labels ET les boutons dans la même collection en ajustant les .Tag de 1 à 10
1 à 5 pour les boutons et de 6 à 10 pour les labels, de cette façon il est bien démontrer que ce sont les clés qui sont prise en compte.
Cette façon de procéder est plus souple, elle ne tient pas compte de l'ordre de création des contrôles.
Serveur 1 : Collections 2.xls Serveur réserve : Collections 2.xls
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
