Sujet Précédent Sujet Suivant

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

Résolu/Fermé
Ein85 Messages postés 32 Date d'inscription jeudi 10 décembre 2015 Statut Membre Dernière intervention 2 mars 2016 - 25 févr. 2016 à 22:07
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 3 mars 2016 à 12:13
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!
A voir également:

2 réponses

Réponse 1 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
26 févr. 2016 à 09:39
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...
2
Ein85 Messages postés 32 Date d'inscription jeudi 10 décembre 2015 Statut Membre Dernière intervention 2 mars 2016
28 févr. 2016 à 17:53
Bonjour,

J'ai appliqué tes changements et tout semble bien fonctionner maintenant, donc un grand merci à toi!

Par contre, pour ta remarque finale à propos de la suppression de l'instance de classe, pourrais-tu être plus précis stp (je ne suis malheureusement pas encore très à l'aise avec les modules de classe) ?
Je suppose que créer une nouvelle sub en diminuant le compteur de 1 (i.e. ButtonCount = ButtonCount - 1) n'est pas suffisant.

Merci d'avance!
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743 > Ein85 Messages postés 32 Date d'inscription jeudi 10 décembre 2015 Statut Membre Dernière intervention 2 mars 2016
1 mars 2016 à 09:45
Salut,

Je suppose que créer une nouvelle sub en diminuant le compteur de 1 (i.e. ButtonCount = ButtonCount - 1) n'est pas suffisant.
En effet. 
    'supprime
    Set Me.ButtonGroup = Nothing
    UserForm1.Controls.Remove strName
0
Ein85 Messages postés 32 Date d'inscription jeudi 10 décembre 2015 Statut Membre Dernière intervention 2 mars 2016
2 mars 2016 à 21:38
Excellent, Merci beaucoup!
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743 > Ein85 Messages postés 32 Date d'inscription jeudi 10 décembre 2015 Statut Membre Dernière intervention 2 mars 2016
3 mars 2016 à 08:11
Bonjour,

A vrai dire, il reste un élément à supprimer.
En faisant cela, tu :
> supprimes les contrôles dans le UserForm
> supprimes l'instancde de classe
Mais il reste un indice de ta variable tableau Buttons à supprimer.
Pour cela, dans ton module, place cette procédure : 
Sub Redimensionne(strNom As String)
Dim i As Long, Cpt As Long

    'on détermine l'indice du bouton supprimé
    On Error GoTo Supprime
    For i = 1 To UBound(Buttons)
        If Buttons(i).ButtonGroup.Name = strNom Then Exit For
    Next i
Supprime:
    'on le supprime
    Set Buttons(i) = Nothing
    Cpt = i
    'on boucle sur les instances suivantes pour les "décaler" vers la droite
    For i = Cpt To UBound(Buttons) - 1
        Set Buttons(i) = Buttons(i + 1)
    Next i
    'redimensionnement
    ReDim Preserve Buttons(UBound(Buttons) - 1)
End Sub


et appelle là, depuis le module de classe, en remplaçant : 
    'supprime
    Set Me.ButtonGroup = Nothing
    UserForm1.Controls.Remove strName

par : 
        'Delete l'instance de classe
        strName = ButtonGroup.Name
        Call Redimensionne(strName)
        Set Me.ButtonGroup = Nothing
        UserForm1.Controls.Remove strName


Maintenant, tu as un code qui supprimes proprement les contrôles ajoutés.

Si tu veux aller plus loin, avec un code faisant appel à des fonctions, dis le...
0
Réponse 2 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
3 mars 2016 à 12:13
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
0

Discussions similaires

Un seul de mes écouteurs marche. Que faire ?
VM_417 -
vali54 -

4 réponses
Que peut faire 3fois/j un homme, mais qu'1fois/j une femme
Soter -
Raymond PENTIER -

1 réponse
programme qui n'affiche pas le mot secret
EMy.chev -
yg_be -

3 réponses
Devinette
Boura10000 -
Utilisateur anonyme -

2 réponses
paiment 4x nickel sur top achat
Lohan -
Afrikarnak -

1 réponse