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
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
A voir également:
- Macro qui s'exécute deux fois après un clic
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Deux ecran pc - Guide
- Deux whatsapp sur un téléphone - Guide
- Un ecouteur sur deux marche ✓ - Forum Audio
2 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 757
26 févr. 2016 à 09:39
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 :
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 :
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 :
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...
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
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 757
3 mars 2016 à 12:13
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
Module "Module1"
Module de Classe "Class1"
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
28 févr. 2016 à 17:53
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!
1 mars 2016 à 09:45
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.
2 mars 2016 à 21:38
3 mars 2016 à 08:11
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 :
et appelle là, depuis le module de classe, en remplaçant :
par :
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...