Discussion :

[LeForestier]

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 peu 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.

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.

'----------------------------------------------------------------------
Le design de l'UserForm
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

(Voir image en annexe)
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
'----------------------------------------------------------------------
Dand le module de l'UserForm

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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

Dans un Module de classe nommé « CL_DemoCC »

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
34
35
36
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

Dans un module Public

Code :

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

1
2
Option Explicit
Public Transfer(6)

Les classeurs 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.
Le classeur démo 1

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.
Le classeur démo 2

En cas de problème n'hésitez pas..
Cordialement.