VBA - Collections de classes et collections d'objets
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.
Introduction
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