Discussion :

[Qwazerty]

Salut

Dans le cadre d'une autre contribution en cours visant à gérer "automatiquement" le dialogue entre une base de données (contenue dans un tableau structuré) et un UserForm, j'ai eu besoin de gérer des option-boutons (radio-boutons), je vous propose donc une gestion de ceci via deux modules de classe.
Le but est d'avoir un seul événement qui nous retourne le changement de sélection sur un groupe de bouton radio.
Ainsi le code suivant (détaillé plus loin) permet d'avoir rapidement le résultat suivant

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
Option Explicit
 
Private WithEvents OptionGroupeA As Cls_OptBoutGroupe
Private WithEvents OptionGroupeB As Cls_OptBoutGroupe
 
Private Sub OptionGroupeA_OptionButtonGetFocus(ActiveButton As Cls_OptBoutPlus)
    TxtChoixA.Text = ActiveButton.ReturnValue
End Sub
 
Private Sub OptionGroupeB_OptionButtonGetFocus(ActiveButton As Cls_OptBoutPlus)
    TxtChoixB.Text = ActiveButton.ReturnValue
End Sub
 
Private Sub UserForm_Initialize()
    'On initialise les groupe de bouton
    Set OptionGroupeA = New Cls_OptBoutGroupe
    OptionGroupeA.InitializeGroupe Me, "GrpA", Array("ChoixA1", "ChoixA2", "ChoixA3", "ChoixA4", "ChoixA5")
 
    Set OptionGroupeB = New Cls_OptBoutGroupe
    OptionGroupeB.InitializeGroupe Me, "GrpB" ', F_Data.ListObjects("Tab_NomChoixB").DataBodyRange.Value
End Sub

La gestion des boutons est faite via les deux Modules de classe que vous devrez ajouter à votre projet


Cls_OptBoutPlus :
Une capsule qui va permettre d'ajouter quelques propriétés au bouton.

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
Option Explicit
 
Private pParent As Cls_OptBoutGroupe
Private pIndex As Integer
Private pReturnValue As String
 
Private WithEvents OptBout As MSForms.OptionButton
 
 
'###############################################
 
 
Public Sub InitBout(aParent As Cls_OptBoutGroupe, anOptBouton As MSForms.OptionButton, NewIndex As Integer, Optional aReturnValue As String = "")
    Set pParent = aParent
    Set OptBout = anOptBouton
    'On défii le type de retour en fonction des informations transmises
    pReturnValue = IIf(aReturnValue = "", NewIndex, aReturnValue)
    pIndex = NewIndex
End Sub
 
Friend Property Let Index(anIndex As Integer)
    pIndex = anIndex
End Property
 
Public Property Get Index() As Integer
    Index = pIndex
End Property
 
Private Sub OptBout_Change()
    'L'option bouton a changé, on transmet l'info au parent
    pParent.OneOptionBouton_Change Me
End Sub
 
Public Sub Activate()
    'On active l'option-bouton
    OptBout.Value = True
End Sub
 
Friend Property Get TheOptionButton() As MSForms.OptionButton
    Set TheOptionButton = OptBout
End Property
 
Public Property Get ReturnValue() As String
    ReturnValue = pReturnValue
End Property

Cls_OptBoutGroupe :
Il contient la collection des OptBoutPlus ayant le même GroupeName.

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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 
Option Explicit
 
Public Event OptionButtonGetFocus(ActiveButton As Cls_OptBoutPlus)
Public Event ButtonChanged(Button As Cls_OptBoutPlus)
 
Private OptionBoutGroupe As Collection
Private pParent As Object 'Form ou Frame
Private pIndexFocused As Variant
 
 
'###############################################
 
 
Private Sub Class_Initialize()
    'On crée une instance
    Set OptionBoutGroupe = New Collection
    'Init
    pIndexFocused = -1
End Sub
 
Private Sub Class_Terminate()
    'On détruit l'instance
    Set OptionBoutGroupe = Nothing
End Sub
 
 
'###############################################
 
 
Public Property Get Count() As Integer
    Count = OptionBoutGroupe.Count
End Property
 
Public Property Get Item(ByVal anIndex As Integer) As Cls_OptBoutPlus
    If (anIndex > 0) And (anIndex <= OptionBoutGroupe.Count) Then Set Item = OptionBoutGroupe.Item(anIndex)
End Property
 
Public Property Get ReturnActiveValue() As Variant
    'On regarde si une valeur de retour est prévue sinon on retourne l'index de la collection
    If pIndexFocused <> -1 Then
        ReturnActiveValue = Item(pIndexFocused).ReturnValue
    End If
    'Reste vide si -1
End Property
 
Public Property Get IndexActive() As Variant
    IndexActive = pIndexFocused
End Property
 
 
'###############################################
 
 
Public Function InitializeGroupe(ControlParent As Object, OptionBouton_GroupName As String, Optional TabOfReturnValues As Variant)
Dim Ctrl As Control, NewOptBout As Cls_OptBoutPlus
Dim iIndexInsert As Integer, iTabNext As Integer, FindIndex As Boolean
Dim StrValue As String
Dim NeedInsert As Boolean
Dim TabOrderCtrl() As String
Dim tabValueCorrect
 
    'On conserve le parent
    Set pParent = ControlParent
 
    'On s'assure de la cohérence des données
    If (Not pParent Is Nothing) And (OptionBouton_GroupName <> vbNullString) Then
        'On dimensionne le tableau
        ReDim TabOrderCtrl(0 To 1, 1 To 5) 'On ajoutera les éléments de 5 en 5 par la suite (gestion mémoire)
        'On recherche les option-boutons faisant partie du groupe dans le userform
        For Each Ctrl In pParent.Controls
            'On verifie le type du control
            If LCase(TypeName(Ctrl)) = "optionbutton" Then
                'On vérifie qu'il appartient au groupe
                If Ctrl.GroupName = OptionBouton_GroupName Then
                    'On tient compte de la position TabIndex pour l'ordre dans la collection
                    iIndexInsert = 0
                    FindIndex = False
                    NeedInsert = False
                    'On boucle sur les éléments déjà présents
                    While iIndexInsert <= UBound(TabOrderCtrl, 2) And Not FindIndex
                        iIndexInsert = iIndexInsert + 1
                        'On compare le tabOrder pour l'inserer dans la liste
                        If TabOrderCtrl(0, iIndexInsert) = vbNullString Then
                            'On est sur un emplacement vide, on ajoute le ctrl dans la liste
                            FindIndex = True
                        ElseIf TabOrderCtrl(0, iIndexInsert) > Ctrl.TabIndex Then
                            'On doit inserer le contrôle ici et décaler le reste vers le bas
                            FindIndex = True
                            NeedInsert = True
                        End If
                    Wend
 
                    'On regarde si un décalage doit avoir lieu
                    If NeedInsert Then
                        'On vérifie qu'un emmplacement est libre en bas du tableau sinon on l'agrandi (de 5 en 5)
                        If TabOrderCtrl(0, UBound(TabOrderCtrl, 2)) <> vbNullString Then ReDim Preserve TabOrderCtrl(0 To 1, 1 To UBound(TabOrderCtrl, 2) + 5)
                        'On décale les valeurs vers le bas
                        'On part du bas
                        iTabNext = UBound(TabOrderCtrl, 2)
                        While iTabNext > iIndexInsert
                            'On décale vers le bas
                            TabOrderCtrl(0, iTabNext) = TabOrderCtrl(0, iTabNext - 1)
                            TabOrderCtrl(1, iTabNext) = TabOrderCtrl(1, iTabNext - 1)
                            'On pointe l'index suivant
                            iTabNext = iTabNext - 1
                        Wend
                    End If
 
                    'On ajoute le ctrl à l'emplacement détérminé
                    TabOrderCtrl(0, iIndexInsert) = Ctrl.TabIndex
                    TabOrderCtrl(1, iIndexInsert) = Ctrl.Name
                End If
            End If
        Next
 
        'On met en place les options bouton dans la collection
        iTabNext = 1
        While iTabNext <= UBound(TabOrderCtrl, 2)
            If TabOrderCtrl(0, iTabNext) <> vbNullString Then
                'On pointe le contrôle
                Set Ctrl = pParent.Controls(TabOrderCtrl(1, iTabNext))
 
                'On regarde si une valeur de retour est prévue
                StrValue = vbNullString
                On Error Resume Next
                    'Cas d'un tableau simple
                    StrValue = TabOfReturnValues(iTabNext - 1) 'base0
                    'Cas d'une plage de valeur issue d'un range en colonne
                    StrValue = TabOfReturnValues(iTabNext, 1)
                    'Cas d'une plage de valeur issue d'un range en ligne
                    StrValue = TabOfReturnValues(1, iTabNext)
                On Error GoTo 0
 
                'On l'encapsule et on l'initialise
                'Si un alias n'est pas fourni, on passe le numéro d'index
                Set NewOptBout = New Cls_OptBoutPlus
                NewOptBout.InitBout Me, Ctrl, iTabNext, IIf(StrValue = vbNullString, iTabNext, StrValue)
 
                'On ajoute à la collection
                'Si un alias n'est pas fourni, on passe le nom du controls associé
                OptionBoutGroupe.Add NewOptBout, IIf(StrValue = vbNullString, Ctrl.Name, StrValue)
            End If
 
            iTabNext = iTabNext + 1
        Wend
    End If
End Function
 
 
Friend Sub OneOptionBouton_Change(OptBoutFocused As Cls_OptBoutPlus)
'Procédure global appelé par tous les membres de la collection
Dim RetVal As Variant
 
    'On déclenche l'événement standard
    RaiseEvent ButtonChanged(OptBoutFocused)
 
    'On vérifie que le changement l'a amené à true
    If OptBoutFocused.TheOptionButton.Value Then
        'On conserve la valeur
        pIndexFocused = OptBoutFocused.Index
 
        'On déclenche l'événement Focus
        RaiseEvent OptionButtonGetFocus(OptBoutFocused)
    End If
 
End Sub
 
Public Function GetButtonByIndex(anIndex As Variant) As Cls_OptBoutPlus
Dim iButt As Integer
 
    'On regarde s'il est contenu dans les index ou dans le key(valeur retour ou nomcontrol) de la collection
    On Error Resume Next
        Set GetButtonByIndex = OptionBoutGroupe(anIndex)
    On Error GoTo 0
 
End Function
 
Public Function FocusButton(anIndex As Variant) As Boolean
'Active le bouton ayant l'index anIndex
Dim iBouton As Integer, FindReturn As Boolean
Dim anOptBoutP As Cls_OptBoutPlus
 
    'On regarde si l'index n'est pas vide
    If anIndex <> vbNullString Then
        'On pointe le bouton correspondant
        Set anOptBoutP = GetButtonByIndex(anIndex)
 
        'On vérifie qu'il existe
        If Not anOptBoutP Is Nothing Then
            'On l'active
            anOptBoutP.Activate
        Else
            'Bouton introuvable, on déselectionne tous les boutons
            If pIndexFocused > -1 Then
                Set anOptBoutP = OptionBoutGroupe.Item(pIndexFocused + 1) '19h52 avc '-1
                anOptBoutP.TheOptionButton.Value = False
                pIndexFocused = -1
            End If
        End If
    End If
 
End Function

Il est déclaré de la manière suivante dans votre UserForm

Code :

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

Private WithEvents OptionGroupeA As Cls_OptBoutGroupe

Il déclenchera ainsi les événements suivant

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub OptionGroupeA_ButtonChanged(Button As Cls_OptBoutPlus)
    'Déclenché lorsque qu'un bouton change d'état
    'True -> False
    'False -> True
End Sub
 
Private Sub OptionGroupeA_OptionButtonGetFocus(ActiveButton As Cls_OptBoutPlus)
    'Déclenché lorsque qu'un bouton passe à l'état True
 
End Sub

Pour créer cette collection, il suffit d'invoquer la procédure InitializeGroupe de la façon suivante

Code :

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

1
2
3
    'On initialise le groupe de bouton
    Set OptionGroupeA = New Cls_OptBoutGroupe
    OptionGroupeA.InitializeGroupe Me, "GrpA", Array("ChoixA1", "ChoixA2", "ChoixA3", "ChoixA4", "ChoixA5")

Ici on instancie un nouveau groupe de bouton nommé OptionGroupeA, on lui indique ensuite les informations suivantes

1. Le contenant, UserForm ou Frame. Ici le UserForm(Me)
2. Le nom du groupe. ici "GrpA". Il représente le nom que vous avez donné à la propriété GroupeName de votre groupe de bouton radio.
3. Un array [facultatif] contenant autant de valeurs alternatives que de bouton-radio. C'est cette valeur qui sera retournée pour définir/retourner le bouton selectionné. Si cette liste est omise, c'est l'index de position qui sera utiliser pour retourner/définir le bouton actif.Lors de la sélection d'un des boutons, un événement renvoi l'index du bouton selectionné ou s'il est précisé une valeur spécifique attribuée à chaque bouton

Ici l'array est inscrit "en dur" mais vous pouvez simplement transmettre un plage de valeur issue d'un Range de la façon suivante.

Code :

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

1
2
    Set OptionGroupeB = New Cls_OptBoutGroupe
    OptionGroupeB.InitializeGroupe Me, "GrpB", F_Data.ListObjects("Tab_GroupeB").DataBodyRange.Value

Dans cet exemple, les valeurs sont dans un tableau structuré, la plage fournie peut-être en colonne ou en ligne.
Exemple en Colonne



Attention: La propriété TabIndex des option-boutons doit impérativement correspondre à l'ordre dans lequel vous souhaitez que les option-boutons soient placés dans la collection, si ça n'est pas le cas, les valeurs retournées par le groupe ne correspondront pas aux bons index. Si cette étape est omise, les boutons d'un même GroupeName seront rangé dans la collection en fonction de leur ordre de création sur le userform... ce qui ne correspondra pas toujours à vos besoins.



Je joins un fichier de démo pour ceux qui le souhiate

++
Qwaz