IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Contribuez Discussion :

Gestion BoutonRadio Automatique


Sujet :

Contribuez

  1. #1
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 621
    Points : 8 086
    Points
    8 086
    Par défaut Gestion BoutonRadio Automatique
    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
    Nom : ChoixVBA.gif
Affichages : 200
Taille : 81,5 Ko
    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
    Nom : Projet.png
Affichages : 191
Taille : 3,8 Ko

    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
    Nom : Plage Colonne.png
Affichages : 174
Taille : 5,1 Ko


    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.
    Nom : FastStoneEditor.png
Affichages : 187
Taille : 26,9 Ko


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

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  2. #2
    Membre chevronné Avatar de curt
    Homme Profil pro
    Ingénieur Etudes
    Inscrit en
    mars 2006
    Messages
    1 445
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur Etudes
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : mars 2006
    Messages : 1 445
    Points : 2 177
    Points
    2 177
    Par défaut
    Bonsoir Qwazerty,

    décidément, les tableaux structurés deviennent de plus en plus d'actualité.
    Les tutos ne manquent pas et amènent une multitude de possibilités.

    Merci pour cette contribution.
    Excellentes fêtes de fin d'année.

    Curt
    Pas de demande par MP, sinon j'correctionne plus, j'dynamite, j'disperse, j'ventile !!!
    ---------------------------------------------------------------------
    Vous avez un talent insoupçonné... Faites-en profitez les autres. Un p'tit CLIC pour une grande cause.
    Et si vous faisiez un bon geste en 2020 ? Soyez utile, ça vous changera ! Moi, ça m’a changé !

  3. #3
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 621
    Points : 8 086
    Points
    8 086
    Par défaut
    Bonjour Curt

    Merci pour ce commentaire ça fait toujours plaisir
    J'espère que ça sera utile et utilisé

    Citation Envoyé par curt Voir le message
    décidément, les tableaux structurés deviennent de plus en plus d'actualité.
    Les tutos ne manquent pas et amènent une multitude de possibilités.
    C'est que je trouve ces structures super pratiques, elles permettent d'avoir une réelle simplification du code et du coup me semblent vraiment incontournables.

    Je te souhaite également de passer de très bonnes fêtes de fin d'année

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  4. #4
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 148
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 148
    Points : 49 407
    Points
    49 407
    Billets dans le blog
    92
    Par défaut
    Salut Curt,

    Les tableaux structurés ont 12 ans (ils sont apparus avec la version 2007) et, comme le dit Qwaz, ils permettent une simplification et une sécurisation, en Excel tout d'abord, mais également en VBA comme le montre la contribution de Qwaz, ainsi que celle de Philippe.

    Je pense que ce n'est pas une option de les utiliser et qu'ils ont leur place dans des classeurs Excel conçus de manière professionnelle. Les outils actuels d'Excel, dont Power Query, utilisent ces tableaux structurés et il n'est plus question, en 2019, de les ignorer et de les laisser de côté...

    @ Qwaz: Merci pour cette contribution. J'en attends d'autres du même tonneau ... C'est Noël sur DVP-EXCEL!! Bravo pour ces deux très chouettes contributions. Continue, on adore!
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  5. #5
    Membre chevronné Avatar de curt
    Homme Profil pro
    Ingénieur Etudes
    Inscrit en
    mars 2006
    Messages
    1 445
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur Etudes
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : mars 2006
    Messages : 1 445
    Points : 2 177
    Points
    2 177
    Par défaut
    Bonjour à tous et BONNE ANNEE,

    Effectivement Pierre tu as raison. Les tableaux structurés existent depuis Excel 2007, mais peu de gens les utilisent.
    Mon commentaire portait surtout sur le fait que de plus en plus de tutos et autres contributions apparaissent et sont un formidable arguments pour convaincre les plus récalcitrants.
    Bravo à tous et encore une fois et bonne année.
    Curt
    Pas de demande par MP, sinon j'correctionne plus, j'dynamite, j'disperse, j'ventile !!!
    ---------------------------------------------------------------------
    Vous avez un talent insoupçonné... Faites-en profitez les autres. Un p'tit CLIC pour une grande cause.
    Et si vous faisiez un bon geste en 2020 ? Soyez utile, ça vous changera ! Moi, ça m’a changé !

  6. #6
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    janvier 2010
    Messages
    10 656
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : janvier 2010
    Messages : 10 656
    Points : 25 440
    Points
    25 440
    Billets dans le blog
    31
    Par défaut
    Bonjour Quaz,
    Chouette contribution
    J'ai mis du temps à réagir parce-que je voulais tester les procédures.
    Je pensais étant donné le titre "Gestion BoutonRadio Automatique" que la propriété Caption du bouton prendrait automatiquement la valeur contenue dans les cellules de la colonne et ainsi TabIndex serait également dans l'ordre des valeurs encodées comme illustré ci-dessous avec un contrôle CheckBox.
    Ai-je mal compris le but ou bien ton développement n'est pas terminé ?

    Nom : Auto CheckBox.png
Affichages : 110
Taille : 11,7 Ko
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Ma dernière contribution : VBA - Les macros complémentaires

  7. #7
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 621
    Points : 8 086
    Points
    8 086
    Par défaut
    Salut

    Merci pour ton retour.

    En fait l'Alias et le Caption ne sont pas corrélés... vu que les bouton-radios sont paramétrés en design-mode l'utilisateur met ce qu'il souhaite, du moins j'étais parti la dessus...
    Mais ça me semble une bonne idée en effet, je suis sur autre chose mais j'ai modifié le code dans ce sens en intégrant ça dans une option du InitializeGroupe.
    J'ai conservé l'ordre de tabulation, ça permet de pouvoir maitriser l'ordre dans lequel les valeurs s'affichent. Par contre ça n'est plus une nécessité absolue, si l'utilisateur met l'option ReplaceCaptionByAlias à True dans le Init, les Alias seront forcement en corrélation avec le caption.

    Voila le code à jour (avec quelques modifications que j'avais réalisé il y a quelques jours.

    Cls_OptBoutGroupe

    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
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    Option Explicit
    '#################################################
    '#          Cls_OptBoutGroupe v1.1
    '#################################################
    '#
    '#  Code by :   Qwazerty
    '#              https://www.developpez.net/forums/u723/qwazerty/
    '#
    '#  Date    :   29/12/19
    '#
    '#  Mise en ligne sur DVP
    '#  https://www.developpez.net/forums/d2034766/logiciels/microsoft-office/excel/contribuez/gestion-boutonradio-automatique/
    '#
    '#################################################
    '#
    '#  01/01/20 : Ajout BackColor | ForColor | Locked | Ajout du Get Parent (lecture seul)
    '#  06/01/20 : Ajout suite à remarque de Philippe Tulliez. Gestion du Caption en corélation avec l'Alias (suivant valeur ReplaceCaptionByAlias dans InitializeGroupe)
    '#
    '#################################################
     
     
    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
     
     
    '###############################################
    ' Contructeur & Destructeur & Initialisation
    '###############################################
     
    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 Function InitializeGroupe(OneOptionBoutonOfGroupe As MSForms.OptionButton, Optional TabOfAlias As Variant, Optional ReplaceCaptionByAlias As Boolean)
    Dim Ctrl As Control, NewOptBout As Cls_OptBoutPlus
    Dim iIndexInsert As Long, iTabNext As Integer, FindIndex As Boolean
    Dim StrValue As String
    Dim NeedInsert As Boolean
    Dim TabOrderCtrl() As String
    Dim tabValueCorrect
    Dim GrpName As String
     
        If Not OneOptionBoutonOfGroupe Is Nothing Then
            'On conserve le parent
            Set pParent = OneOptionBoutonOfGroupe.Parent
            'On récupère le nom du groupe
            GrpName = OneOptionBoutonOfGroupe.GroupName
     
            'On s'assure de la cohérence des données
            If (GrpName <> 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 = GrpName 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 = TabOfAlias(iTabNext - 1) 'base0
                            'Cas d'une plage de valeur issue d'un range en colonne
                            StrValue = TabOfAlias(iTabNext, 1)
                            'Cas d'une plage de valeur issue d'un range en ligne
                            StrValue = TabOfAlias(1, iTabNext)
                        On Error GoTo 0
     
                        'On l'encapsule et on l'initialise
                        'Si un alias n'est pas fourni, si strvalue est vide il sera remplacer par l'index au niveau de la classe
                        Set NewOptBout = New Cls_OptBoutPlus
                        NewOptBout.InitBout Me, Ctrl, iTabNext, StrValue
     
                        If ReplaceCaptionByAlias Then NewOptBout.Caption = 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 If
    End Function
     
     
     
    '###############################################
    ' Propriétés & Fonctions associées
    '###############################################
     
    Public Property Get Parent() As Object
        Set Parent = pParent
    End Property
     
    Public Property Let BackColor(aColor As OLE_COLOR)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).TheOptionButton.BackColor = aColor
        Next
    End Property
     
    Public Property Get BackColor() As OLE_COLOR
        'On retourne la couleur du 1er optionbouton
        If Count > 0 Then BackColor = Item(1).TheOptionButton.BackColor
    End Property
     
    Public Property Let ForColor(aColor As OLE_COLOR)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).TheOptionButton.ForColor = aColor
        Next
    End Property
     
    Public Property Get ForColor() As OLE_COLOR
        'On retourne la couleur du 1er optionbouton
        If Count > 0 Then ForColor = Item(1).TheOptionButton.ForColor
    End Property
     
    Public Property Get Count() As Long
        Count = OptionBoutGroupe.Count
    End Property
     
    Public Property Get Item(ByVal anIndex As Long) As Cls_OptBoutPlus
        If (anIndex > 0) And (anIndex <= OptionBoutGroupe.Count) Then Set Item = OptionBoutGroupe.Item(anIndex)
    End Property
     
    Public Property Get Alias() As Variant
        'On regarde si une valeur de retour est prévue sinon on retourne l'index de la collection
        If pIndexFocused <> -1 Then
            Alias = Item(pIndexFocused).Alias
        End If
        'Reste vide si -1
    End Property
     
    Public Property Get IndexActive() As Variant
        IndexActive = pIndexFocused
    End Property
     
    Public Property Get Locked() As Boolean
        'On retourne la valeur du 1ère élément
        If Count > 0 Then Locked = Item(1).TheOptionButton.Locked
    End Property
     
    Public Property Let Locked(aValue As Boolean)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).TheOptionButton.Locked = aValue
        Next
    End Property
     
    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[Alias](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 anOptBoutP As Cls_OptBoutPlus
    Dim CancelSelect As Boolean
     
        'Init
        CancelSelect = True
     
        '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
                CancelSelect = False
            End If
        End If
     
        If CancelSelect Then
            If pIndexFocused > -1 Then
                Set anOptBoutP = OptionBoutGroupe.Item(pIndexFocused)
                anOptBoutP.TheOptionButton.Value = False
                pIndexFocused = -1
            End If
        End If
     
    End Function
     
     
    '###############################################
    ' Gestion des Evènements
    '###############################################
     
     
    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
    Cls_OptBoutPlus
    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
    Option Explicit
    '#################################################
    '#          Cls_OptBoutPlus v1.1
    '#################################################
    '#
    '#  Code by :   Qwazerty
    '#              https://www.developpez.net/forums/u723/qwazerty/
    '#
    '#  Date    :   29/12/19
    '#
    '#  Mise en ligne sur DVP
    '#  https://www.developpez.net/forums/d2034766/logiciels/microsoft-office/excel/contribuez/gestion-boutonradio-automatique/
    '#
    '#################################################
    '#
    '#  01/01/20 : Supression Let Index, inutile qu'il soit accessible
    '#  06/01/20 : Ajout suite à remarque de Philippe Tulliez. Gestion du Caption en corélation avec l'Alias -- Ajout Let / Get Caption
    '#
    '#################################################
     
    Private pParent As Cls_OptBoutGroupe
    Private pIndex As Long
    Private pAlias As String
     
    Private WithEvents OptBout As MSForms.OptionButton
     
     
    '###############################################
    ' Contructeur & Destructeur & Initialisation
    '###############################################
     
     
    Public Sub InitBout(aParent As Cls_OptBoutGroupe, anOptBouton As MSForms.OptionButton, ByVal NewIndex As Long, Optional anAliasValue As String = "")
        Set pParent = aParent
        Set OptBout = anOptBouton
        'On défii le type de retour en fonction des informations transmises
        pAlias = IIf(anAliasValue = "", NewIndex, anAliasValue)
        pIndex = NewIndex
    End Sub
     
     
    '###############################################
    ' Propriétés
    '###############################################
     
     
    Public Property Get Index() As Long
        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 Alias() As String
        Alias = pAlias
    End Property
     
    Public Property Let Caption(aValue As String)
        OptBout.Caption = aValue
    End Property
     
    Public Property Get Caption() As String
        Caption = OptBout.Caption
    End Property
    Utilisation dans le UserForm
    La 1ère liste est issue d'un Array interne donc codé en dur.
    La deuxième liste est issue d'un Tableau Structure contenu sur une feuille du classeur. L'option ReplaceCaptionByAlias est activé, les captions sont remplacés par les Alias présent dans le Tableau Structuré.
    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
     
    Option Explicit
     
    Private WithEvents OptionGroupeA As Cls_OptBoutGroupe
    Private WithEvents OptionGroupeB As Cls_OptBoutGroupe
     
    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
        TxtChoixA.Text = ActiveButton.Alias
    End Sub
     
    Private Sub OptionGroupeB_OptionButtonGetFocus(ActiveButton As Cls_OptBoutPlus)
        TxtChoixB.Text = ActiveButton.Alias
    End Sub
     
    Private Sub UserForm_Initialize()
        'On initialise les groupe de bouton
        Set OptionGroupeA = New Cls_OptBoutGroupe
        OptionGroupeA.InitializeGroupe OptB_ChoixA1, Array("ChoixA1", "ChoixA2", "ChoixA3", "ChoixA4", "ChoixA5")
     
        Set OptionGroupeB = New Cls_OptBoutGroupe
        OptionGroupeB.InitializeGroupe OptB_ChoixB1, F_Data.ListObjects("Tab_GroupeB").DataBodyRange.Value, True
    End Sub
    Nom : Tab_Groupe.png
Affichages : 128
Taille : 30,3 Ko
    Fichier à jour joint à la discution.

    Merci Philippe.

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  8. #8
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    janvier 2010
    Messages
    10 656
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : janvier 2010
    Messages : 10 656
    Points : 25 440
    Points
    25 440
    Billets dans le blog
    31
    Par défaut
    Bonjour Qwaz,
    Merci pour ton retour
    Personnellement, je suis pour le maximum d'automatisation et du paramétrage de base donc avec les tableaux structurés par exemple, si l'utilisateur a choisi dans une colonne la Validation de données-List, je vais utiliser automatiquement dans le UserForm un ComboBox qui fera référence à la même Liste et sans avoir besoin de l'utilisation d'un UserForm, un simple double-clic sur cette cellule va enclencher un UserForm de recherche permettant d'afficher toutes les lignes et colonnes de la table qui est référencée en colonne dans la validation de données (pratique par exemple pour une liste de clients, fournisseurs dont le nombre dépasse ce qui est ingérable.
    C'est donc totalement transparent.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Ma dernière contribution : VBA - Les macros complémentaires

  9. #9
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 621
    Points : 8 086
    Points
    8 086
    Par défaut
    Salut

    Ce que tu décrits me fait penser à Access, qui permet me semble-t-il (je l'utilise très peu car pas accessible dans mon entreprise) à la possibilité de créer un formulaire en utilisant les controles les plus adaptés en fonction des données.

    Cet contribution est en fait une "contribution collatérale" j'avais besoin de cette gestion des boutons radio (je vais d'ailleurs réfléchir à l'intégration des case à cocher dans la même veine en tl'intégrant si possible dans les mêmes Classes).
    Je ne visais donc pas ici une automatisation complète, juste un retour unique d'un ensemble de boutons radio. (D'illeurs il faut que e mette à jour l'autre contribution )

    Merci pour ces échanges.

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  10. #10
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 621
    Points : 8 086
    Points
    8 086
    Par défaut
    Salut

    Avec la gestion des CheckBox à choix multiple.
    Il est aussi possible d'imposer les valeurs séléctionnées, si des Alias ou des index inexistants sont demandés, ils sont ignorés

    Cls_OptBoutGroupe
    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
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    Option Explicit
    Option Base 1
    '#################################################
    '#          Cls_OptBoutGroupe v1.2
    '#################################################
    '#
    '#  Code by :   Qwazerty
    '#              https://www.developpez.net/forums/u723/qwazerty/
    '#
    '#  Date    :   29/12/19
    '#
    '#  Mise en ligne sur DVP
    '#  https://www.developpez.net/forums/d2034766/logiciels/microsoft-office/excel/contribuez/gestion-boutonradio-automatique/
    '#
    '#################################################
    '#
    '#  01/01/20 : Ajout BackColor | ForColor | Locked | Ajout du Get Parent (lecture seul)
    '#  06/01/20 : Ajout suite à remarque de Philippe Tulliez. Gestion du Caption en corélation avec l'Alias (suivant valeur ReplaceCaptionByAlias dans InitializeGroupe)
    '#  07/01/20 : Ajout suite à remarque de Philippe Tulliez. Utilisation des Bouton-Radio ou CheckBox
    '#  07/01/20 : Ajout de Alias au niveau "Collection" qui retourne l'enssemble des éléments séléctionnés, séparés par des ";"
    '#
    '#################################################
     
     
    Public Event OptionGetChecked(ActiveOption As Cls_OptBoutPlus)
    Public Event OptionChanged(TheOption As Cls_OptBoutPlus)
     
     
    Private OptionBoutGroupe As Collection
    Private pParent As Object 'Form ou Frame
    Private pIndexFocused As Variant
     
    '###############################################
    ' Contructeur & Destructeur & Initialisation
    '###############################################
     
    Private Sub Class_Initialize()
        'On crée une instance
        Set OptionBoutGroupe = New Collection
        'Init
        pIndexFocused = Array(-1)
    End Sub
     
    Private Sub Class_Terminate()
        'On détruit l'instance
        Set OptionBoutGroupe = Nothing
    End Sub
     
    Public Function InitializeGroupe(OneGroupeControl As MSForms.Control, Optional TabOfAlias As Variant, Optional ReplaceCaptionByAlias As Boolean)
    Dim Ctrl As Control, NewOptBout As Cls_OptBoutPlus
    Dim iIndexInsert As Long, iTabNext As Integer, FindIndex As Boolean
    Dim StrValue As String
    Dim NeedInsert As Boolean
    Dim TabOrderCtrl() As String
    Dim tabValueCorrect
    Dim GrpName As String
     
        If Not OneGroupeControl Is Nothing Then
            If LCase(TypeName(OneGroupeControl)) = "optionbutton" Or LCase(TypeName(OneGroupeControl)) = "checkbox" Then
                'On conserve le parent
                Set pParent = OneGroupeControl.Parent
                'On récupère le nom du groupe
                GrpName = OneGroupeControl.GroupName
     
                'On s'assure de la cohérence des données
                If (GrpName <> 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" Or LCase(TypeName(Ctrl)) = "checkbox" Then
                            'On vérifie qu'il appartient au groupe
                            If Ctrl.GroupName = GrpName 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 = TabOfAlias(iTabNext - 1) 'base0
                                'Cas d'une plage de valeur issue d'un range en colonne
                                StrValue = TabOfAlias(iTabNext, 1)
                                'Cas d'une plage de valeur issue d'un range en ligne
                                StrValue = TabOfAlias(1, iTabNext)
                            On Error GoTo 0
     
                            'On l'encapsule et on l'initialise
                            'Si un alias n'est pas fourni, si strvalue est vide il sera remplacer par l'index au niveau de la classe
                            Set NewOptBout = New Cls_OptBoutPlus
                            NewOptBout.InitBout Me, Ctrl, iTabNext, StrValue
     
                            If ReplaceCaptionByAlias Then NewOptBout.Caption = 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 If
        End If
    End Function
     
     
     
    '###############################################
    ' Propriétés & Fonctions associées
    '###############################################
     
    Public Property Get Parent() As Object
        Set Parent = pParent
    End Property
     
    Public Property Let BackColor(aColor As OLE_COLOR)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).OptionControl.BackColor = aColor
        Next
    End Property
     
    'Public Property Get BackColor() As OLE_COLOR
    '    'On retourne la couleur du 1er optionbouton
    '    If Count > 0 Then BackColor = Item(1).OptionControl.BackColor
    'End Property
     
    Public Property Let ForColor(aColor As OLE_COLOR)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).OptionControl.ForColor = aColor
        Next
    End Property
     
    'Public Property Get ForColor() As OLE_COLOR
    '    'On retourne la couleur du 1er optionbouton
    '    If Count > 0 Then ForColor = Item(1).OptionControl.ForColor
    'End Property
     
    Public Property Get Count() As Long
        Count = OptionBoutGroupe.Count
    End Property
     
    Public Property Get Item(ByVal anIndex As Long) As Cls_OptBoutPlus
        If (anIndex > 0) And (anIndex <= Count) Then Set Item = OptionBoutGroupe.Item(anIndex)
    End Property
     
    Public Property Get Alias() As Variant
    Dim iOpt, strOpt As String
        'On regarde si une valeur de retour est prévue sinon on retourne l'index de la collection
        If pIndexFocused(1) <> -1 Then
            'On retourne un array contenant le valeurs s'il y en a plusieurs
            For iOpt = 1 To UBound(pIndexFocused)
                If strOpt <> "" Then strOpt = strOpt & ";"
                strOpt = strOpt & Me.GetButtonByIndex(pIndexFocused(iOpt)).Alias
            Next
            Alias = strOpt
        End If
        'Reste vide si -1
    End Property
     
    Public Property Get ActiveIndexes() As Variant
        If UBound(pIndexFocused) > 1 Then
            ActiveIndexes = pIndexFocused
        Else
            ActiveIndexes = pIndexFocused(1)
        End If
    End Property
     
     
    Public Property Get Locked() As Boolean
        'On retourne la valeur du 1ère élément
        If Count > 0 Then Locked = Item(1).OptionControl.Locked
    End Property
     
    Public Property Let Locked(aValue As Boolean)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).OptionControl.Locked = aValue
        Next
    End Property
     
    Public Sub ClearSelection()
    Dim iOpt As Integer
        For iOpt = 1 To Count
            Item(iOpt).Checked = False
        Next
        pIndexFocused = Array(-1)
    End Sub
     
    Public Function GetButtonByIndex(anIndex As Variant) As Cls_OptBoutPlus
    'Accepte les Alias comme index
    Dim iButt As Integer
     
        'On regarde s'il est contenu dans les index ou dans le key[Alias](valeur retour ou nomcontrol) de la collection
        On Error Resume Next
            Set GetButtonByIndex = OptionBoutGroupe(CInt(anIndex))
            Set GetButtonByIndex = OptionBoutGroupe(anIndex)
        On Error GoTo 0
    End Function
     
    Public Function CheckOptions(Indexes As Variant) As Boolean
    'Active les options contenu dans Indexes
    'Indexes peut-être,
        'Une valeur numérique seule
        'Une liste de valeurs numériques séparées par des ;
        'Une liste d'Alias séparés par des ;
        'Un Array de valeurs numériques ou d'Alias
     
    Dim anOptBoutP As Cls_OptBoutPlus
    Dim ListIndex As Variant, iList As Integer
    Dim iOpt As Integer
     
     
        'Init
        'On deselectionne toutes les options
        ClearSelection
     
     
        If IsArray(Indexes) Then
            ListIndex = Indexes
        Else
            'On transforme le texte en array
            ListIndex = Split(";" & Indexes, ";")
        End If
     
        'On traite la liste
        If Not IsEmpty(ListIndex) Then
            'On boucle sur la liste
            For iList = LBound(ListIndex) To UBound(ListIndex)
                'On pointe l'option correspondante Note: vérifie si "1" est utilisé comme index ou alias...
                Set anOptBoutP = GetButtonByIndex(ListIndex(iList))
     
                'On vérifie qu'elle existe
                If Not anOptBoutP Is Nothing Then
                    'On l'active
                    anOptBoutP.Activate
                End If
            Next
        End If
    End Function
     
     
     
    '###############################################
    ' Gestion des Evènements
    '###############################################
     
     
    Friend Sub OneControl_Change(OptionFocused As Cls_OptBoutPlus)
    'Procédure global appelé par tous les membres de la collection
    Dim RetVal As Variant
    Dim iOpt As Integer, StrSel As String
     
        'On vérifie que le changement l'a amené à true
        If OptionFocused.Checked Then
    '        'On conserve la valeur
    '        pIndexFocused = OptionFocused.Index
    '
            'On déclenche l'événement Focus
            RaiseEvent OptionGetChecked(OptionFocused)
        End If
     
        'On fait le bilan des éléments selectionnés
        For iOpt = 1 To Count
            If Me.Item(iOpt).Checked Then
                If StrSel <> "" Then StrSel = StrSel & ";"
                StrSel = StrSel & CStr(Me.Item(iOpt).Index)
            End If
        Next
        If StrSel = "" Then
            pIndexFocused = Array(-1)
        Else
            pIndexFocused = Split(";" & StrSel, ";")
        End If
     
        'On déclenche l'événement standard
        RaiseEvent OptionChanged(OptionFocused)
    End Sub
    Cls_OptBoutPlus
    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
    Option Explicit
    '#################################################
    '#          Cls_OptBoutPlus v1.2
    '#################################################
    '#
    '#  Code by :   Qwazerty
    '#              https://www.developpez.net/forums/u723/qwazerty/
    '#
    '#  Date    :   29/12/19
    '#
    '#  Mise en ligne sur DVP
    '#  https://www.developpez.net/forums/d2034766/logiciels/microsoft-office/excel/contribuez/gestion-boutonradio-automatique/
    '#
    '#################################################
    '#
    '#  01/01/20 : Supression Let Index, inutile qu'il soit accessible
    '#  06/01/20 : Ajout suite à remarque de Philippe Tulliez. Gestion du Caption en corélation avec l'Alias -- Ajout Let / Get Caption
    '#  07/01/20 : Ajout suite à remarque de Philippe Tulliez. Utilisation des Bouton-Radio ou CheckBox
    '#  07/01/20 : Ajout de Get Checked
    '#
    '#################################################
     
    Private pParent As Cls_OptBoutGroupe
    Private pIndex As Long
    Private pAlias As String
     
    Private WithEvents OptBout As MSForms.OptionButton
    Private WithEvents ChkGrp As MSForms.CheckBox
    Private GenericControl As MSForms.Control
     
     
    '###############################################
    ' Contructeur & Destructeur & Initialisation
    '###############################################
     
     
    Public Sub InitBout(aParent As Cls_OptBoutGroupe, aControl As Object, ByVal NewIndex As Long, Optional anAliasValue As String = "")
        Set pParent = aParent
        Set GenericControl = aControl
        Select Case LCase(TypeName(aControl))
            Case "optionbutton"
                Set OptBout = aControl
            Case "checkbox"
                Set ChkGrp = aControl
        End Select
        'On défii le type de retour en fonction des informations transmises
        pAlias = IIf(anAliasValue = "", NewIndex, anAliasValue)
        pIndex = NewIndex
    End Sub
     
     
    '###############################################
    ' Propriétés
    '###############################################
     
     
    Public Property Get Index() As Long
        Index = pIndex
    End Property
     
    Public Sub Activate()
        'On active le control
        GenericControl.Value = True
    End Sub
     
    Public Property Get Checked() As Boolean
        Checked = GenericControl.Value
    End Property
     
    Public Property Let Checked(aValue As Boolean)
        GenericControl.Value = aValue
    End Property
     
    Friend Property Get OptionControl() As MSForms.Control
        Set OptionControl = GenericControl
    End Property
     
    Public Property Get Alias() As String
        Alias = pAlias
    End Property
     
    Public Property Let Caption(aValue As String)
        GenericControl.Caption = aValue
    End Property
     
    Public Property Get Caption() As String
        Caption = GenericControl.Caption
    End Property
     
    Public Property Get Parent() As Cls_OptBoutGroupe
        Set Parent = pParent
    End Property
     
     
    '###############################################
    ' Gestion des Evènements
    '###############################################
     
    Private Sub ChkGrp_Change()
        'L'option bouton a changé, on transmet l'info au parent
        pParent.OneControl_Change Me
     
    End Sub
     
    Private Sub OptBout_Change()
        'L'option bouton a changé, on transmet l'info au parent
        pParent.OneControl_Change Me
    End Sub
    Utilisation dans le 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
     
    Option Explicit
     
    Private WithEvents OptionGroupeA As Cls_OptBoutGroupe
    Private WithEvents OptionGroupeB As Cls_OptBoutGroupe
    Private WithEvents OptionGroupeC As Cls_OptBoutGroupe
    Private WithEvents OptionGroupeD As Cls_OptBoutGroupe
     
    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 CmdSel_Click()
        If TxtSelA.Text <> "" Then OptionGroupeA.CheckOptions TxtSelA.Text
        If TxtSelB.Text <> "" Then OptionGroupeB.CheckOptions TxtSelB.Text
        If TxtSelC.Text <> "" Then OptionGroupeC.CheckOptions TxtSelC.Text
        If TxtSelD.Text <> "" Then OptionGroupeD.CheckOptions TxtSelD.Text
     
    End Sub
     
    Private Sub OptionGroupeA_OptionGetChecked(ActiveOption As Cls_OptBoutPlus)
        'Déclenché lorsque qu'un bouton passe à l'état True
        TxtChoixA.Text = ActiveOption.Alias
    End Sub
     
    Private Sub OptionGroupeB_OptionGetChecked(ActiveOption As Cls_OptBoutPlus)
        TxtChoixB.Text = ActiveOption.Alias
    End Sub
     
    Private Sub OptionGroupeC_OptionChanged(TheOption As Cls_OptBoutPlus)
        TxtFruit.Text = OptionGroupeC.Alias
    End Sub
     
     
     
    Private Sub OptionGroupeD_OptionChanged(TheOption As Cls_OptBoutPlus)
        TxtLeg.Text = OptionGroupeD.Alias
    End Sub
     
    Private Sub UserForm_Initialize()
        'On initialise les groupe de bouton
     
        'Groupe de Boutons-Radio utilisant les Captions inscrit en Design-time mais qui retourne des Alias fournis sous forme d'un Array
        Set OptionGroupeA = New Cls_OptBoutGroupe
        OptionGroupeA.InitializeGroupe OptB_ChoixA1, Array("ChoixA1", "ChoixA2", "ChoixA3", "ChoixA4", "ChoixA5")
     
        'Groupe de Boutons-Radio utilisant les valeurs fournis dans un Tableau Structuré pour les Caption et les Alias
        Set OptionGroupeB = New Cls_OptBoutGroupe
        OptionGroupeB.InitializeGroupe OptB_ChoixB1, F_Data.ListObjects("Tab_GroupeB").DataBodyRange.Value, True
     
        'Groupe de CheckBox utilisant les valeurs fournis dans un Tableau Structuré pour les Caption et les Alias
        Set OptionGroupeC = New Cls_OptBoutGroupe
        OptionGroupeC.InitializeGroupe Ckb_Fruit1, F_Data.ListObjects("Tab_GroupeC").DataBodyRange.Value, True
     
        'Groupe de CheckBox utilisant Utilisant les Caption saisi en design-time, sans alias fourni
        Set OptionGroupeD = New Cls_OptBoutGroupe
        OptionGroupeD.InitializeGroupe CkBLeg1
     
    End Sub
    Nom : 4 Liste.png
Affichages : 120
Taille : 56,4 Ko

    Fichier test
    TestRadioBoutonAutoV1.3.xlsm

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  11. #11
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    avril 2002
    Messages
    3 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : avril 2002
    Messages : 3 621
    Points : 8 086
    Points
    8 086
    Par défaut
    Salut

    Quelques corrections / Mise à jour

    Cls_OptBoutGroupe
    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
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    Option Explicit
    Option Base 1
    'Option Compare Text 'Todo vérifier si nécessaire : Ou plutôt mettre une option Compare mode si utile pour les comparaisons d'alias par exemple (ou StrComp)
     
     
    '#################################################
    '#          Cls_OptBoutGroupe v1.3
    '#################################################
    '#
    '#  Code by :   Qwazerty
    '#              https://www.developpez.net/forums/u723/qwazerty/
    '#
    '#  Date    :   29/12/19
    '#
    '#  Mise en ligne sur DVP
    '#  https://www.developpez.net/forums/d2034766/logiciels/microsoft-office/excel/contribuez/gestion-boutonradio-automatique/
    '#
    '#################################################
    '#
    '#  01/01/20 : Ajout BackColor | ForColor | Locked | Ajout du Get Parent (lecture seul)
    '#  06/01/20 : Ajout suite à remarque de Philippe Tulliez. Gestion du Caption en corélation avec l'Alias (suivant valeur ReplaceCaptionByAlias dans InitializeGroupe)
    '#  07/01/20 : Ajout suite à remarque de Philippe Tulliez. Utilisation des Bouton-Radio ou CheckBox
    '#  07/01/20 : Ajout de Alias au niveau "Collection" qui retourne l'enssemble des éléments séléctionnés, séparés par des ";"
    '#  13/01/20 : Ajout d'un retour à CheckOptions pour permettre un contrôle entre demande et validation
    '#  13/01/20 : Remplacement du nom de la propriété Get Alias par ActiveAlias
    '#  13/01/20 : Ajout de la propriété TypeName
    '#  13/01/20 : Ajout Get BackColor en mode Friend
    '#
    '#################################################
     
     
    Public Event OptionGetChecked(ActiveOption As Cls_OptBoutPlus)
    Public Event OptionChanged(TheOption As Cls_OptBoutPlus)
     
     
    Private OptionBoutGroupe As Collection
    Private pParent As Object 'Form ou Frame
    Private pIndexFocused As Variant
     
    '###############################################
    ' Contructeur & Destructeur & Initialisation
    '###############################################
     
    Private Sub Class_Initialize()
        'On crée une instance
        Set OptionBoutGroupe = New Collection
        'Init
        pIndexFocused = Array(-1)
    End Sub
     
    Private Sub Class_Terminate()
        'On détruit l'instance
        Set OptionBoutGroupe = Nothing
    End Sub
     
    Public Function InitializeGroupe(OneGroupeControl As MSForms.Control, Optional TabOfAlias As Variant, Optional ReplaceCaptionByAlias As Boolean)
    Dim Ctrl As Control, NewOptBout As Cls_OptBoutPlus
    Dim iIndexInsert As Long, iTabNext As Integer, FindIndex As Boolean
    Dim StrValue As String
    Dim NeedInsert As Boolean
    Dim TabOrderCtrl() As String
    Dim tabValueCorrect
    Dim GrpName As String
     
        If Not OneGroupeControl Is Nothing Then
            If LCase(Information.TypeName(OneGroupeControl)) = "optionbutton" Or LCase(Information.TypeName(OneGroupeControl)) = "checkbox" Then
                'On conserve le parent
                Set pParent = OneGroupeControl.Parent
                'On récupère le nom du groupe
                GrpName = OneGroupeControl.GroupName
     
                'On s'assure de la cohérence des données
                If (GrpName <> 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(Information.TypeName(Ctrl)) = "optionbutton" Or LCase(Information.TypeName(Ctrl)) = "checkbox" Then
                            'On vérifie qu'il appartient au groupe
                            If Ctrl.GroupName = GrpName 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 = TabOfAlias(iTabNext - 1) 'base0
                                'Cas d'une plage de valeur issue d'un range en colonne
                                StrValue = TabOfAlias(iTabNext, 1)
                                'Cas d'une plage de valeur issue d'un range en ligne
                                StrValue = TabOfAlias(1, iTabNext)
                            On Error GoTo 0
     
                            'On l'encapsule et on l'initialise
                            'Si un alias n'est pas fourni, si strvalue est vide il sera remplacer par l'index au niveau de la classe
                            Set NewOptBout = New Cls_OptBoutPlus
                            NewOptBout.InitBout Me, Ctrl, iTabNext, StrValue
     
                            If ReplaceCaptionByAlias Then NewOptBout.Caption = 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 If
        End If
    End Function
     
     
     
    '###############################################
    ' Propriétés & Fonctions associées
    '###############################################
     
     
    Public Property Get TypeName()
        If pParent Is Nothing Then
            TypeName = "Nothing"
        Else
            'On retourne le type associé
            TypeName = IIf(LCase(Information.TypeName(pParent)) = "checkbox", "GrpCheckBox", "GrpOptionButton")
        End If
    End Property
     
    Public Property Get Parent() As Object
        Set Parent = pParent
    End Property
     
    Public Property Let BackColor(aColor As OLE_COLOR)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).OptionControl.BackColor = aColor
        Next
    End Property
     
    Friend Property Get BackColor() As OLE_COLOR
        'On retourne la couleur du 1er optionbouton
        If Count > 0 Then BackColor = Item(1).OptionControl.BackColor
    End Property
     
    Public Property Let ForColor(aColor As OLE_COLOR)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).OptionControl.ForColor = aColor
        Next
    End Property
     
    'Public Property Get ForColor() As OLE_COLOR
    '    'On retourne la couleur du 1er optionbouton
    '    If Count > 0 Then ForColor = Item(1).OptionControl.ForColor
    'End Property
     
    Public Property Get Count() As Long
        Count = OptionBoutGroupe.Count
    End Property
     
    Public Property Get Item(ByVal anIndex As Long) As Cls_OptBoutPlus
        If (anIndex > 0) And (anIndex <= Count) Then Set Item = OptionBoutGroupe.Item(anIndex)
    End Property
     
    'Public Property Get Alias() As Variant
    '    'On retourne l'ensemble des alias du groupe
    '
    'End Property
     
    Public Property Get ActiveAlias() As Variant
    Dim iOpt, strOpt As String
        'On regarde si une valeur de retour est prévue sinon on retourne l'index de la collection
        If pIndexFocused(1) <> -1 Then
            'On retourne un array contenant les valeurs s'il y en a plusieurs
            For iOpt = 1 To UBound(pIndexFocused)
                If strOpt <> "" Then strOpt = strOpt & CstDelim1
                strOpt = strOpt & Me.GetButtonByIndex(pIndexFocused(iOpt)).Alias
            Next
            ActiveAlias = strOpt
        End If
        'Reste vide si -1
    End Property
     
    Public Property Get ActiveIndexes() As Variant
        If UBound(pIndexFocused) > 1 Then
            ActiveIndexes = pIndexFocused
        Else
            ActiveIndexes = pIndexFocused(1)
        End If
    End Property
     
    Public Property Get Locked() As Boolean
        'On retourne la valeur du 1ère élément
        If Count > 0 Then Locked = Item(1).OptionControl.Locked
    End Property
     
    Public Property Let Locked(aValue As Boolean)
    Dim iOpt As Integer
        'On boucle sur tous les bouton
        For iOpt = 1 To Count
            Item(iOpt).OptionControl.Locked = aValue
        Next
    End Property
     
    Public Sub ClearSelection()
    Dim iOpt As Integer
        For iOpt = 1 To Count
            Item(iOpt).Checked = False
        Next
        pIndexFocused = Array(-1)
    End Sub
     
    Public Function GetButtonByIndex(anIndex As Variant) As Cls_OptBoutPlus
    'Accepte les Alias comme index
    Dim iButt As Integer
     
        'On regarde s'il est contenu dans les index ou dans le key[Alias](valeur retour ou nomcontrol) de la collection
        On Error Resume Next
            Set GetButtonByIndex = OptionBoutGroupe(CInt(anIndex))
            Set GetButtonByIndex = OptionBoutGroupe(anIndex)
        On Error GoTo 0
    End Function
     
    Public Function CheckOptions(Indexes As Variant) As Variant
    'Active les options contenu dans Indexes
    'Indexes peut-être,
        'Une valeur numérique seule
        'Une liste de valeurs numériques séparées par des ;
        'Une liste d'Alias séparés par des ;
        'Un Array de valeurs numériques ou d'Alias
     
    Dim anOptBoutP As Cls_OptBoutPlus
    Dim ListIndex As Variant, iList As Integer
    Dim iOpt As Integer
        'Init
        'On deselectionne toutes les options
        ClearSelection
     
        If IsArray(Indexes) Then
            ListIndex = Indexes
        Else
            'On transforme le texte en array
            ListIndex = Split(Indexes, CstDelim1)
        End If
     
        'On traite la liste
        If Not IsEmpty(ListIndex) Then
            'On boucle sur la liste
            For iList = LBound(ListIndex) To UBound(ListIndex)
                'On pointe l'option correspondante Note: vérifie si "1" est utilisé comme index ou alias...
                Set anOptBoutP = GetButtonByIndex(ListIndex(iList))
     
                'On vérifie qu'elle existe        'On l'active
                If Not anOptBoutP Is Nothing Then anOptBoutP.Activate
            Next
        End If
     
        'On retourne la selection (permet de comparer pour voir s'il y a eu des pertes en ligne
        CheckOptions = Me.ActiveAlias
     
    End Function
     
     
     
    '###############################################
    ' Gestion des Evènements
    '###############################################
     
     
    Friend Sub OneControl_Change(OptionFocused As Cls_OptBoutPlus)
    'Procédure global appelé par tous les membres de la collection
    Dim RetVal As Variant
    Dim iOpt As Integer, StrSel As String
     
        'On vérifie que le changement l'a amené à true
        If OptionFocused.Checked Then
    '        'On conserve la valeur
    '        pIndexFocused = OptionFocused.Index
    '
            'On déclenche l'événement Focus
            RaiseEvent OptionGetChecked(OptionFocused)
        End If
     
        'On fait le bilan des éléments selectionnés
        For iOpt = 1 To Count
            If Me.Item(iOpt).Checked Then
                If StrSel <> "" Then StrSel = StrSel & CstDelim1
                StrSel = StrSel & CStr(Me.Item(iOpt).Index)
            End If
        Next
        If StrSel = "" Then
            pIndexFocused = Array(-1)
        Else
            pIndexFocused = Split(CstDelim1 & StrSel, CstDelim1)
        End If
     
        'On déclenche l'événement standard
        RaiseEvent OptionChanged(OptionFocused)
    End Sub
    Cls_OptBoutPlus
    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
    Option Explicit
    '#################################################
    '#          Cls_OptBoutPlus v1.2
    '#################################################
    '#
    '#  Code by :   Qwazerty
    '#              https://www.developpez.net/forums/u723/qwazerty/
    '#
    '#  Date    :   29/12/19
    '#
    '#  Mise en ligne sur DVP
    '#  https://www.developpez.net/forums/d2034766/logiciels/microsoft-office/excel/contribuez/gestion-boutonradio-automatique/
    '#
    '#################################################
    '#
    '#  01/01/20 : Supression Let Index, inutile qu'il soit accessible
    '#  06/01/20 : Ajout suite à remarque de Philippe Tulliez. Gestion du Caption en corélation avec l'Alias -- Ajout Let / Get Caption
    '#  07/01/20 : Ajout suite à remarque de Philippe Tulliez. Utilisation des Bouton-Radio ou CheckBox
    '#  07/01/20 : Ajout de Get Checked
    '#
    '#################################################
     
    Private pParent As Cls_OptBoutGroupe
    Private pIndex As Long
    Private pAlias As String
     
    Private WithEvents OptBout As MSForms.OptionButton
    Private WithEvents ChkGrp As MSForms.CheckBox
    Private GenericControl As MSForms.Control
     
     
    '###############################################
    ' Contructeur & Destructeur & Initialisation
    '###############################################
     
     
    Public Sub InitBout(aParent As Cls_OptBoutGroupe, aControl As Object, ByVal NewIndex As Long, Optional anAliasValue As String = "")
        Set pParent = aParent
        Set GenericControl = aControl
        Select Case LCase(TypeName(aControl))
            Case "optionbutton"
                Set OptBout = aControl
            Case "checkbox"
                Set ChkGrp = aControl
        End Select
        'On défii le type de retour en fonction des informations transmises
        pAlias = IIf(anAliasValue = "", NewIndex, anAliasValue)
        pIndex = NewIndex
    End Sub
     
     
    '###############################################
    ' Propriétés
    '###############################################
     
     
    Public Property Get Index() As Long
        Index = pIndex
    End Property
     
    Public Sub Activate()
        'On active le control
        GenericControl.Value = True
    End Sub
     
    Public Property Get Checked() As Boolean
        Checked = GenericControl.Value
    End Property
     
    Public Property Let Checked(aValue As Boolean)
        GenericControl.Value = aValue
    End Property
     
    Friend Property Get OptionControl() As MSForms.Control
        Set OptionControl = GenericControl
    End Property
     
    Public Property Get Alias() As String
        Alias = pAlias
    End Property
     
    Public Property Let Caption(aValue As String)
        GenericControl.Caption = aValue
    End Property
     
    Public Property Get Caption() As String
        Caption = GenericControl.Caption
    End Property
     
    Public Property Get Parent() As Cls_OptBoutGroupe
        Set Parent = pParent
    End Property
     
     
    '###############################################
    ' Gestion des Evènements
    '###############################################
     
    Private Sub ChkGrp_Change()
        'L'option bouton a changé, on transmet l'info au parent
        pParent.OneControl_Change Me
     
    End Sub
     
    Private Sub OptBout_Change()
        'L'option bouton a changé, on transmet l'info au parent
        pParent.OneControl_Change Me
    End Sub
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

Discussions similaires

  1. Réponses: 0
    Dernier message: 16/11/2007, 11h00
  2. Réponses: 2
    Dernier message: 09/06/2006, 10h16
  3. [IDE] Gestion automatique des headers d'unités
    Par Clorish dans le forum Outils
    Réponses: 1
    Dernier message: 27/06/2005, 18h52
  4. [Plugin]Gestion de génération automatique de code
    Par Maggic dans le forum Eclipse Java
    Réponses: 1
    Dernier message: 11/05/2004, 11h35
  5. [SYBASE] gestion de tâches automatiques
    Par gaille dans le forum Sybase
    Réponses: 2
    Dernier message: 16/06/2003, 23h12

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo