Macro qui s'exécute deux fois après un clic Résolu

Question

Bonjour à tous,

Je suis en train de créer un programme qui crée des objets de manière dynamique dans un UserForm. Le principe est simple, quand on clique sur un bouton "+", juste en dessous se crée un bouton "-" suivi d'une liste déroulante. Et quand on clique sur ce nouveau bouton "-", ça supprime ledit bouton et la liste déroulante associée.

Sur mon UserForm, il y a 3 boutons "+". Quand on clique sur le premier, tout se passe comme prévu. Par contre, si l'on clique sur le 2ème ou le 3ème, la macro s'exécute deux fois et deux boutons ainsi que deux listes déroulantes sont créées par clic. 

J'ai procédé à un debug en pas à pas mais rien à faire, je ne comprends pas pourquoi le programme agit comme si l'on avait cliqué deux fois de suite sur le bouton.

Pourriez-vous m'aider svp?

Vous pouvez trouver mon fichier en cliquant sur ce lien: http://www.cjoint.com/c/FBzu3gda5Zr

Dans la 1ère feuille, appuyez sur le bouton de commande pour faire apparaître le UserForm et une fois celui-ci ouvert, cliquez sur le 2ème ou 3ème bouton "+" pour répliquer le bug.

Merci d'avance pour votre aide!

pijaku · Accepted Answer

Bonjour, A chaque fois que tu créées un bouton, tu réassignes tous les boutons à ta classe. Cela te créées donc deux instances de classe avec le même bouton. Il te faut donc revoir ta manière d'instancier la classe pour faire en sorte de n'instancier que les nouveaux boutons créés. Comment faire? A l'activation de ton UserForm, instancier ta classe avec les boutons existants. Le code est : Private Sub UserForm_Activate() Dim ctl As Control For Each ctl In UserForm1.Controls If TypeName(ctl) = "CommandButton" Then Call AssignToClass(ctl) End If Next End Sub Remarque : on passe le contrôle ctl (représentant un CommandButton) en paramètre de la Sub AssignToClass. Il faut donc modifier celle-ci pour qu'elle assigne, le contrôle passé en paramètre, à la classe : Option Explicit Dim Buttons() As New Class1 Dim ButtonCount As Integer Sub AssignToClass(ctl As Control) ' Create the Button objects ButtonCount = ButtonCount + 1 ReDim Preserve Buttons(ButtonCount) Set Buttons(ButtonCount).ButtonGroup = ctl End Sub Remarque : la variable ButtonCount est maintenant déclarée en public car elle doit être "visible" depuis la classe ET l'UserForm. De plus, elle doit être conservée en mémoire pour être incrémentée. Il suffit d'ajouter le paramètre à passer dans le code de la classe. Pour cela, tu dois déclarer ta variable CB As Control et le passer à AssignToClass : Public WithEvents ButtonGroup As CommandButton Private Sub ButtonGroup_Click() Dim CB As Control If ButtonGroup.Name = "Plus0" Then For Each Control In UserForm1.Controls If Left(Control.Name, 7) = "Minus_1" Or Control.Name = "Plus0" Then CtlCounter = CtlCounter + 1 End If Next Control Set CB = UserForm1.Frame1.Controls.Add("Forms.CommandButton.1", "Minus_1" & CtlCounter) UserForm1.Controls("Minus_1" & CtlCounter).Top = UserForm1.Plus0.Top + UserForm1.Plus0.Height * CtlCounter UserForm1.Controls("Minus_1" & CtlCounter).Left = UserForm1.Plus0.Left UserForm1.Controls("Minus_1" & CtlCounter).Height = UserForm1.Plus0.Height UserForm1.Controls("Minus_1" & CtlCounter).Width = UserForm1.Plus0.Width UserForm1.Controls("Minus_1" & CtlCounter).Caption = "-" Set CboB = UserForm1.Frame1.Controls.Add("Forms.ComboBox.1", "CboB_1_" & CtlCounter) UserForm1.Controls("CboB_1_" & CtlCounter).Top = UserForm1.ComboBox1.Top + UserForm1.ComboBox1.Height * CtlCounter UserForm1.Controls("CboB_1_" & CtlCounter).Left = UserForm1.ComboBox1.Left UserForm1.Controls("CboB_1_" & CtlCounter).Height = UserForm1.ComboBox1.Height UserForm1.Controls("CboB_1_" & CtlCounter).Width = UserForm1.ComboBox1.Width UserForm1.Controls("CboB_1_" & CtlCounter).AddItem ("Include") UserForm1.Controls("CboB_1_" & CtlCounter).AddItem ("Exclude") UserForm1.Controls("CboB_1_" & CtlCounter).ListIndex = 0 UserForm1.Frame1.Height = UserForm1.Frame1.Height + UserForm1.Plus0.Height Call AssignToClass(CB) For Each Control In UserForm1.Controls If Control.Top > CB.Top And Control.Name <> CB.Name And Control.Name <> "Frame1" Then Control.Top = Control.Top + CB.Height End If Next Control ElseIf ButtonGroup.Name = "Plus_2_0" Then For Each Control In UserForm1.Controls If Left(Control.Name, 7) = "Minus_2" Or Control.Name = "Plus_2_0" Then CtlCounter = CtlCounter + 1 End If Next Control Set CB = UserForm1.Frame1.Controls.Add("Forms.CommandButton.1", "Minus_2" & CtlCounter) UserForm1.Controls("Minus_2" & CtlCounter).Top = UserForm1.Plus_2_0.Top + UserForm1.Plus_2_0.Height * CtlCounter UserForm1.Controls("Minus_2" & CtlCounter).Left = UserForm1.Plus_2_0.Left UserForm1.Controls("Minus_2" & CtlCounter).Height = UserForm1.Plus_2_0.Height UserForm1.Controls("Minus_2" & CtlCounter).Width = UserForm1.Plus_2_0.Width UserForm1.Controls("Minus_2" & CtlCounter).Caption = "-" Set CboB = UserForm1.Frame1.Controls.Add("Forms.ComboBox.1", "CboB_2_" & CtlCounter) UserForm1.Controls("CboB_2_" & CtlCounter).Top = UserForm1.ComboBox2.Top + UserForm1.ComboBox2.Height * CtlCounter UserForm1.Controls("CboB_2_" & CtlCounter).Left = UserForm1.ComboBox2.Left UserForm1.Controls("CboB_2_" & CtlCounter).Height = UserForm1.ComboBox2.Height UserForm1.Controls("CboB_2_" & CtlCounter).Width = UserForm1.ComboBox2.Width UserForm1.Controls("CboB_2_" & CtlCounter).AddItem ("Include") UserForm1.Controls("CboB_2_" & CtlCounter).AddItem ("Exclude") UserForm1.Controls("CboB_2_" & CtlCounter).ListIndex = 0 UserForm1.Frame1.Height = UserForm1.Frame1.Height + UserForm1.Plus_2_0.Height Call AssignToClass(CB) For Each Control In UserForm1.Controls If Control.Top > CB.Top And Control.Name <> CB.Name And Control.Name <> "Frame1" Then Control.Top = Control.Top + CB.Height End If Next Control ElseIf ButtonGroup.Name = "Plus_3_0" Then For Each Control In UserForm1.Controls If Left(Control.Name, 7) = "Minus_3" Or Control.Name = "Plus_3_0" Then CtlCounter = CtlCounter + 1 End If Next Control Set CB = UserForm1.Frame1.Controls.Add("Forms.CommandButton.1", "Minus_3" & CtlCounter) UserForm1.Controls("Minus_3" & CtlCounter).Top = UserForm1.Plus_3_0.Top + UserForm1.Plus_2_0.Height * CtlCounter UserForm1.Controls("Minus_3" & CtlCounter).Left = UserForm1.Plus_3_0.Left UserForm1.Controls("Minus_3" & CtlCounter).Height = UserForm1.Plus_3_0.Height UserForm1.Controls("Minus_3" & CtlCounter).Width = UserForm1.Plus_3_0.Width UserForm1.Controls("Minus_3" & CtlCounter).Caption = "-" Set CboB = UserForm1.Frame1.Controls.Add("Forms.ComboBox.1", "CboB_3_" & CtlCounter) UserForm1.Controls("CboB_3_" & CtlCounter).Top = UserForm1.ComboBox3.Top + UserForm1.ComboBox3.Height * CtlCounter UserForm1.Controls("CboB_3_" & CtlCounter).Left = UserForm1.ComboBox3.Left UserForm1.Controls("CboB_3_" & CtlCounter).Height = UserForm1.ComboBox3.Height UserForm1.Controls("CboB_3_" & CtlCounter).Width = UserForm1.ComboBox3.Width UserForm1.Controls("CboB_3_" & CtlCounter).AddItem ("Include") UserForm1.Controls("CboB_3_" & CtlCounter).AddItem ("Exclude") UserForm1.Controls("CboB_3_" & CtlCounter).ListIndex = 0 UserForm1.Frame1.Height = UserForm1.Frame1.Height + UserForm1.Plus_3_0.Height Call AssignToClass(CB) For Each Control In UserForm1.Controls If Control.Top > CB.Top And Control.Name <> CB.Name And Control.Name <> "Frame1" Then Control.Top = Control.Top + CB.Height End If Next Control Else: 'Delete Controls For Each Control In UserForm1.Controls If Control.Name <> "Frame1" And Control.Name <> ButtonGroup.Name And Control.Top = ButtonGroup.Top Then UserForm1.Controls.Remove Control.Name End If Next Control 'Shift Controls up For Each Control In UserForm1.Controls If Control.Top > ButtonGroup.Top And Control.Name <> ButtonGroup.Name And Control.Name <> "Frame1" Then Control.Top = Control.Top - ButtonGroup.Height End If Next Control UserForm1.Controls.Remove ButtonGroup.Name UserForm1.Frame1.Height = UserForm1.Frame1.Height - UserForm1.Plus0.Height End If End Sub Remarque complémentaire : Il conviendrait également de supprimer, dans ton tableau de bouton, celui correspondant au contrôle que tu effaces. Pour l'instant, tu te contentes, en effet, de supprimer le contrôle dans l'UserForm, mais pas son instance de Classe...

pijaku · Answer

Pour aller un peu plus loin, toujours sur la base de ton UserForm de travail communiqué dans ta question, voici les codes des trois modules :

Module de l'UserForm1
Option Explicit

Private ctlCB As MSForms.CommandButton
Private ctlComb As MSForms.ComboBox

Private Sub UserForm_Initialize()
'Lors de l'initialisation de l'UserForm
Dim ctl As Control
    'attribue le Frame1 à la variable Frm
    Set Frm = Me.Frame1
    'remet à 0 la variable ButtonCount
    ButtonCount = 0
    'boucle sur tous les contrôles du Frame
    'les boutons en dehors du Frame ne seront pas "dynamiques"
    For Each ctl In Frm.Controls
        If TypeName(ctl) = "CommandButton" Then
            'la Sub AssignToClass a besoin de 3 paramètres :
                'Bouton As MSForms.CommandButton
                    'Pour éviter le bug on "transforme"
                    'le "Control" ctl en "CommandButton" CtlCB
            Set ctlCB = ctl
            ctlCB.Height = HAUTEUR  'réglage de la hauteur
                'ComboB As MSForms.ComboBox
                'cf Private Function Combo_Associee_A(Butt As Control) As MSForms.ComboBox
            Set ctlComb = Combo_Associee_A(ctl)
            ctlComb.Height = HAUTEUR
                'Init As Boolean
                '=> différencie les 3 premiers boutons des autres créés dynamiquement
                    'True = Boutons initiaux
                    'False = Autres boutons
            Call AssignToClass(ctlCB, ctlComb, True)
        End If
    Next
End Sub

Private Sub UserForm_Terminate()
'Lors de la destruction de l'UserForm
Dim i As Long
    'Boucle sur la variable Buttons()
    For i = LBound(Buttons) To UBound(Buttons)
        'détruit les dernières instances de Classe
        Set Buttons(i) = Nothing
    Next i
End Sub

Private Function Combo_Associee_A(Butt As Control) As MSForms.ComboBox
'associe la Combobox à son bouton si même Top
'n'est lancée que pour les boutons déjà présents dans le Frame
Dim ctrl As Control

'Boucle sur les contrôles du Frame
    For Each ctrl In Frm.Controls
        'si ComboBox et même Top que le bouton passé en paramètre
        If TypeName(ctrl) = "ComboBox" And ctrl.Top = Butt.Top Then
            'La fonction retourne la ComboBox
            Set Combo_Associee_A = ctrl
            Exit Function
        End If
    Next ctrl
    'Si pas trouvé de ComboBox à associer
    Set Combo_Associee_A = Nothing
End Function 


Module "Module1"
Option Explicit

Public Buttons() As New Class1          'tableau des instances de la classe
Public Frm As MSForms.Frame             'Frame contenant les contrôles existants et ajoutés dynamiquement
Public ButtonCount As Long

Public Const HAUTEUR As Double = 18     'Constante pour régler la hauteur de tous les contrôles du Frame

Sub AssignToClass(Bouton As MSForms.CommandButton, ComboB As MSForms.ComboBox, Init As Boolean)
    '   Create the Button objects
    ButtonCount = ButtonCount + 1
    ReDim Preserve Buttons(ButtonCount)
    Set Buttons(ButtonCount).ButtonGroup = Bouton
    'propriétés du bouton
    With Buttons(ButtonCount)
        'on lui "associe" sa combobox
        Set .Combo_Associee = ComboB
        'propriété Nom
        .strName = Bouton.Name
        'valable pour les 3 boutons contenus initialement dans le Frame
        If Init Then
            'propriétés préfixes des noms "parents"
            .strPrefixCB = "Minus_" & ButtonCount          '"Minus_1", "Minus_2", "Minus_3"
            .strPrefixCOMBO = "CboB_" & ButtonCount & "_"   '"CboB_1_", "CboB_2_", "CboB_3_"
        End If
    End With
End Sub

Sub Redimensionne(strNom As String, Combo As MSForms.ComboBox)
Dim i As Long, Cpt As Long

On Error GoTo Supprime
    'on détermine l'indice du bouton supprimé
    For i = 1 To UBound(Buttons)
        If Buttons(i).ButtonGroup.Name = strNom Then Exit For
    Next i
Supprime:
    On Error GoTo 0
    'Delete bouton
    Frm.Controls.Remove strNom
    'Delete Combobox associée
    Frm.Controls.Remove Combo.Name
    'on supprime l'indice de la variable Buttons() correspondant
    'ce qui détruit l'instance de Classe (cf Class_Terminate)
    Set Buttons(i) = Nothing
    Cpt = i
    'on boucle sur les indices suivants pour les "décaler" vers la droite
    For i = Cpt To UBound(Buttons) - 1
        Set Buttons(i) = Buttons(i + 1)
    Next i
    'redimensionnement => supprime le dernier indice
    ReDim Preserve Buttons(UBound(Buttons) - 1)
End Sub 


Module de Classe "Class1"
Option Explicit

'****************************************************** Variable Public événements
Public WithEvents ButtonGroup As MSForms.CommandButton

'****************************************************** Propriétés de chaque instance de Classe
Public strName As String                        'Nom
Public Combo_Associee As MSForms.ComboBox       'ComboBox "associée"
                    'remplies uniquement pour les 3 boutons "initiaux" :
Public strPrefixCB As String                    ' = "Minus_" & compteur
Public strPrefixCOMBO As String                 ' = "CboB_" & compteur & "_"

'****************************************************** Procédures événementielles de la Classe
Private Sub Class_Initialize()
    'se déclenche à chaque nouvelle instance de classe
    'cf Sub AssignToClas dans le Module1
    'ligne déclencheur : Set Buttons(ButtonCount).ButtonGroup = Bouton
End Sub

Private Sub ButtonGroup_Click()
'se déclenche au Click sur chaque instance de classe
Dim Boo As Boolean

If Left(strName, 4) = "Plus" Then
        'click sur "+"
        Boo = Create_Ctrl(CtlCounter)
        If Boo = False Then MsgBox "Impossible de créer le bouton"
    Else
        'click sur "-"
        'positionne les contrôles en fonction du Top du CommandButton supprimé
        Place_Ctrl ButtonGroup.Top, "-"
        'Supprime l'indice de Buttons() correspondant et redimensionne Buttons()
        Call Redimensionne(strName, Combo_Associee)
   End If
End Sub

Private Sub Class_Terminate()
    'se déclenche à chaque destruction d'une instance de classe
    'à chaque suppression d'un indice dans la variable Buttons()
    'l'instance de classe correspondante est supprimée
    'cf Sub Redimensionne dans le Module1
    'ligne déclencheur : Set Buttons(i) = Nothing
End Sub

'****************************************************** Fonctions (Méthodes) de la Classe
Function CtlCounter() As Long
'permet la numérotation des contrôles ajoutés dynamiquement
Dim tmpCounter As Long, ctrl As Control
    
    For Each ctrl In Frm.Controls
        If Left(ctrl.Name, 7) = strPrefixCB Or ctrl.Name = strName Then
            tmpCounter = tmpCounter + 1
        End If
    Next ctrl
    CtlCounter = tmpCounter
End Function

Function Create_Ctrl(Ctl_Count As Long) As Boolean
'création des contrôles dynamiques
Dim CB As Control, CboB As Control
    
    'valeur par défaut de la Function
    Create_Ctrl = False
    On Error GoTo Erreur
    'CommandButton
    Set CB = Frm.Controls.Add("Forms.CommandButton.1", strPrefixCB & Ctl_Count)
    With ButtonGroup
        CB.Move .Left, .Top + .Height * Ctl_Count, .Width, HAUTEUR
        CB.Caption = "-"
    End With
    'ComboBox
    Set CboB = Frm.Controls.Add("Forms.ComboBox.1", strPrefixCOMBO & Ctl_Count)
    With Combo_Associee
        CboB.Move .Left, .Top + .Height * Ctl_Count, .Width, HAUTEUR
    End With
    CboB.AddItem "Include"
    CboB.AddItem "Exclude"
    CboB.ListIndex = 0
    'positionne les contrôles en fonction du Top du CommandButton ajouté
    Call Place_Ctrl(CB.Top, "+")
    'création d'une nouvelle instance de classe
    Call AssignToClass(CB, CboB, False)
    'Si pas d'errur, retourne True
    Create_Ctrl = True
    Exit Function
'traitement d'erreur
Erreur:
    Create_Ctrl = False
End Function

Sub Place_Ctrl(Haut As Double, Signe As String)
'positionne les contrôles en fonction
    '- du Top du CommandButton ajouté (Signe = "+")
    '- du Top du CommandButton supprimé (Signe = "-")
Dim ctrl As Control

For Each ctrl In Frm.Controls
        If ctrl.Top > Haut Then
            ctrl.Top = Evaluate(ctrl.Top & Signe & HAUTEUR)
        End If
    Next ctrl
    'redimensionne le Frame
    Frm.Height = Evaluate(Frm.Height & Signe & HAUTEUR)
End Sub

Macro qui s'exécute deux fois après un clic

2 réponses

Discussions similaires

Newsletters