Creer un CommandButton avec control.add puis lui affecter une action sur le clique

Version imprimable

Bonjour,

Je doit créer des bouton de commande par une macro car leur nombres est variable. J'ai réussi a les créer, les positionner et les nommer ( je crois ). Par contre, impossible de leur affecter une action.

Voici mon code épuré de tous ce qui est inutile à ma question :
Code:

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 Private Sub UserForm_Initialize() j = 4 k = 0 Toop = 0 start: k = k + 1 Toop = Toop + 20 Set Obj = Me.Controls.Add("forms.CommandButton.1", "Up" & k) With Obj .Name = "Up" & k .Caption = "+" .Left = 12 .Top = Toop .Width = 18 .Height = 18 End With If Not k = j Then GoTo start Me.Height = Toop + 90 End Sub Private Sub Up1_Click() MsgBox "Ca marche !" End Sub
J'ai bien essayé de rajouter un .OnAction à la création du bouton mais je rencontre cette erreur :
"Erreur d’exécution 438 : Propriété ou méthode non gérée par cet objet"

Je suis désolé de vous solliciter sur ce problème, je suis bien persuadé que cette question à du un jour obtenir une réponse sur un forum mais je n'arrive pas à mettre la main dessus...

Merci d'avance de vos réponse.

25/01/2013, 12h29
Philippe Tulliez

Bonjour,
Si tu as plusieurs boutons à placer utilise plutôt un module de classe.
25/01/2013, 12h41
Limace_hurlante

Très bien, je m'y met. Je viens de trouver un petit tuto de 250 pages qui va m'apprendre les modules de classes.

J'avouerait bien honteusement que j'espérais secrètement un petit : " Mais enfin tu à oublié un guillemet en ligne 4" .

Mais bon, voila une bonne occasion d'apprendre de nouvelles choses.

Merci de ta réponse :)

salut pour ma part j'ai créer aujourd'hui un code pour créer un USF et des contrôles dedans via ma macro

Code:

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
Sub FormGraph()
    Dim y As Integer, Impr As String
    Dim FormTempo As VbComponent
    Dim NewButton As MSForms.CommandButton
    Dim NewLabel As MSForms.Label
    Dim NewComboBox As MSForms.ComboBox
    Dim Formname As String
    Set FormTempo = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
    'Create USF
    With FormTempo
        .Properties("Caption") = "Choix de l'imprimante"
        .Properties("Height") = 105
        .Properties("Width") = 345
    End With
    Formname = FormTempo.Name
    '   Add a combobox
        Set NewComboBox = FormTempo.Designer.Controls _
      .Add("forms.ComboBox.1")
    With NewComboBox
        .Left = 12
        .Top = 30
        .Height = 18
        .Width = 312
        .Name = "Combo1"
    End With
    '   Add a label
        Set NewLabel = FormTempo.Designer.Controls _
      .Add("forms.label.1")
    With NewLabel
        .Caption = "Choisissez l'imprimante"
        .Left = 12
        .Top = 6
        .Height = 18
        .Width = 312
    End With
 
        '   Add a CommandButton
    Set NewButton = FormTempo.Designer.Controls _
      .Add("forms.CommandButton.1")
    With NewButton
        .Caption = "OK"
        .Left = 144
        .Top = 54
        .Height = 24
        .Width = 72
    End With
    With ThisWorkbook.VBProject.VBComponents("UserForm1").CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub UserForm_Initialize()"
        .InsertLines Line + 2, "listPrint"
        .InsertLines Line + 3, "For y = 0 To x"
        .InsertLines Line + 4, "Impr = CStr(TabPrinter(y))"
        .InsertLines Line + 5, "Me.Controls(""Combo1"").AddItem Impr"
        .InsertLines Line + 6, "Next y"
        .InsertLines Line + 7, "End Sub"
        .InsertLines Line + 8, ""
'Controle evenementielle du bouton
        .InsertLines Line + 9, "Private Sub CommandButton1_Click()"
        .InsertLines Line + 10, "Dim xlSheet As Excel.Worksheet"
        .InsertLines Line + 11, "Dim Graphs As Object"
        .InsertLines Line + 12, "Set xlSheet = ThisWorkbook.Sheets(""Graph"")"
        .InsertLines Line + 13, "For Each Graphs In xlSheet.ChartObjects"
        .InsertLines Line + 14, "Graphs.Chart.PrintOut ActivePrinter:= Combo1.value"
        .InsertLines Line + 15, "Next"
        .InsertLines Line + 16, "Me.Hide"
        .InsertLines Line + 17, "End Sub"
    End With
 
    '   Show the form
    Load VBA.UserForms.Add(Formname)
    VBA.UserForms.Add(Formname).Show
    reponse = MsgBox("Voulez-vous ré-imprimer les graphiques?", vbYesNo, "Fin de l'impression")
    If reponse = 7 Then
        ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("UserForm1")
    ElseIf reponse = 6 Then
        VBA.UserForms.Add(Formname).Show
    End If
End Sub

Tu remarqueras que j'ai créé également la procédure événementielle lors de l'initialisation de l'USF et lors du clique sur le bouton d'action via la macro,
J'espère que cela pourra t'apporter de l'aide

25/01/2013, 14h44
Limace_hurlante

Merci Schat6903 !

Est-ce que le fait d'ajouter :

Code:

Private Sub CommandButton1_Click()

seulement après la création du bouton serait la solution ?

Philippe, J'essai de comprendre les module de classe, mais à chaque ligne d'explication, je doit rechercher des explication pour chaque mot . Je crois que ça va largement au delà de mes capacités actuelles mais je m'accroche :)
25/01/2013, 14h54
Schat6903

Il y a quelque chose qui me parait bizarre,
c'est que tu n'as pas déclarer ta variables Obj
D'une part ne devrais tu pas le déclarer en tant que MSForms.CommandButton
et d'autre part , est ce que le fait de creer un bouton dans le formulaire où il sera exploiter ne nécessite pas de "recharger" ce meme formulaire pour prendre en compte les changements?
Pour ma part , la création de mon USF et des controles sont fait à partir d'un module (macro)

Une solution adaptée rapidement pour tes besoins. A toi ensuite d'essayer de comprendre le fonctionnement pour l'utiliser dans d'autres situations.

Dans un premier temps, place ce code dans un module de classe nommé classBouton

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public WithEvents MesBoutons As MSForms.CommandButton
'Cette insctruction permet de faie réagir ton programme aux événements associés à tes boutons
 
Private Sub MesBoutons_Click()
    Dim USF As Object
    Set USF = MesBoutons.Parent
 
    'la partie suivant permet d'identifier l'userform du bouton meme si celui ci est placé sur un frame
    Do
        If TypeName(USF) = "Frame" Then
            Set USF = USF.Parent
        End If
    Loop While TypeName(USF) = "Frame"
 
     'appel de la procédure ClicBouton sur l'userform parent        
    Call USF.ClicBouton(MesBoutons.Name)
 
End Sub

Ensuite, place ce code dans un module normal

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Public CollectionDeBouton() As New ClasseBouton
 
Sub AjouterMesBoutonsALaClasse(ByRef USF As Object)
    Dim i As Long
    Dim ctrls As Control
 
    'Boucle sur tout les controls de l'USF
    For Each ctrls In USF.Controls
        'Si le Tag correspond et que c'est bien un bouton, le code ajoute ce bouton à la collection.
        If ctrls.Tag = "MonTag" And TypeName(ctrls) = "CommandButton" Then
            i = i + 1
            ReDim Preserve CollectionDeBouton(1 To i)
            Set CollectionDeBouton(i).MesBoutons = ctrls
        End If
    Next
 
End Sub

Et enfin place ce code sur ton userform

Code:

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
Option Explicit
 
Private Sub UserForm_Initialize()
 
Dim j As Long, k As Long, toop As Long
Dim obj As Object
 
j = 4
k = 0
toop = 0
 
start:
k = k + 1
toop = toop + 20
 
    Set obj = Me.Controls.Add("forms.CommandButton.1", "Up" & k)
    With obj
        .Name = "Up" & k
        .Caption = "+"
        .Tag = "MonTag"
        .Left = 12
        .Top = toop
        .Width = 18
        .Height = 18
    End With
 
If Not k = j Then GoTo start
 
Me.Height = toop + 90
 
 Call AjouterMesBoutonsALaClasse(Me)
 
End Sub
 
Sub ClicBouton(NomBTN As String)
 
    MsgBox "Vous avez cliqué sur " & NomBTN
 
End Sub

25/01/2013, 16h16
Limace_hurlante

Merci beaucoup AlphaScorpi !

Ça marche super !

Il me reste plus qu'as bien comprendre ta solution pour ne plus vous embêter pour rien :)

Pour ceux que ça interresserait de comprendre l'usage que je fait de ce bout de code, remplacer le code userform ci dessus par celui ci :

Code:

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
Option Explicit
 
Private Sub UserForm_Initialize()
 
 
Dim j As Long, k As Long, toop As Long
Dim obj As Object
 
j = Worksheets("Equipes").Cells(1, 2).Value
k = 0
toop = 40
start:
k = k + 1
toop = toop + 20
 
    Set obj = Me.Controls.Add("forms.label.1")
    With obj
        .Name = "Equipe" & k
        .Caption = k & " - " & Worksheets("Equipes").Cells(k, 1).Value
        .Left = 55
        .Top = toop + 3
        .Width = 90
        .Height = 15
 
    End With
If Not k = 1 Then
    Set obj = Me.Controls.Add("forms.CommandButton.1", "Upp" & k)
    With obj
        .Name = "Upp" & k
        .Caption = "+"
        .Tag = "MonTag"
        .Left = 12
        .Top = toop
        .Width = 18
        .Height = 18
 
    End With
End If
If Not k = j Then
 
    Set obj = Me.Controls.Add("forms.CommandButton.1", "Dwn" & k)
    With obj
        .Name = "Dwn" & k
        .Caption = "-"
        .Tag = "MonTag"
        .Left = 32
        .Top = toop
        .Width = 18
        .Height = 18
    End With
End If
If Not k = j Then GoTo start
Me.Height = toop + 90
Continuer.Top = toop + 45
 
 Call AjouterMesBoutonsALaClasse(Me)
 
End Sub
 
Sub ClicBouton(NomBTN As String)
 Dim Orient As String, Hauteur As Long, Ekip1$, Ekip2$
 
 Hauteur = Mid(NomBTN, 4)
 Orient = Left(NomBTN, 3)
 If Orient = "Upp" Then Hauteur = Hauteur - 1
 Ekip1 = Worksheets("Equipes").Cells(Hauteur, 1).Value
 Ekip2 = Worksheets("Equipes").Cells(Hauteur + 1, 1).Value
 Worksheets("Equipes").Cells(Hauteur, 1).Value = Ekip2
 Worksheets("Equipes").Cells(Hauteur + 1, 1).Value = Ekip1
 Call UserForm_Initialize
 
End Sub

Puis nomer une feuille excel : Equipes
remplir la collone A avec des noms sur quelques lignes
remplir la cellule ba avec =NBVAL(A:A)

Voila !

Je suis sur que beaucoup d'entre vous vont trouver ce code moche mais bon, moi j'en suis très content car il fonctionne :D

Merci encore pour votre aide précieuse, quelque chose me dit que vais faire grand usage de ce module de classe pour la suite de ce programme :D

AlphaScorpi, je ne te remercierais jamais assez pour ce code qui marche si bien.

Mais pour tout te dire, je ne le comprend pas totalement (et ça m’empêche de dormir).
Je me permet ici de te poser quelques questions. Si jamais tu as un peu de temps à tuer et que tu es de bonne humeur, les questions sont les suivantes :

Tout d'abord, j'ai bien compris qu'il fallait rajouter le tag pour "singulariser" mes nouveaux boutons. Ensuite une sub est appelée :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Option Explicit Public CollectionDeBouton() As New ClasseBouton Sub AjouterMesBoutonsALaClasse(ByRef USF As Object) Dim i As Long Dim ctrls As Control 'Boucle sur tout les controls de l'USF For Each ctrls In USF.Controls 'Si le Tag correspond et que c'est bien un bouton, le code ajoute ce bouton à la collection. If ctrls.Tag = "MonTag" And TypeName(ctrls) = "CommandButton" Then i = i + 1 ReDim Preserve CollectionDeBouton(1 To i) Set CollectionDeBouton(i).MesBoutons = ctrls End If Next End Sub
Ce que je ne comprend pas, c'est :
A quoi correspond New classebouton
Pourquois est-il néccésaire de créer une "sous-division" .MesBoutons a la collection
J'ai l'impression que la "sous-division" .MesBoutons n'est pas déclarée, n'est-ce pas nécessaire ?

Ensuite, si j'ai bien compris, lorsque je clique sur un des boutons, le module de classe réagi grace à cette ligne :

Code:

Public WithEvents MesBoutons As MSForms.CommandButton

la, j'ai beau retourner le problème je crois comprendre jusqu’à ce que je comprenne plus ... MesBoutons c'est juste un bout de tableau non ?
Est-ce que je les transforme en MSForms.CommandButton ? ou l'inverse ?
et ensuite alors on réagi à un évènement quelconque avec WithEvents ?

ensuite on as ca :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub MesBoutons_Click() Dim USF As Object Set USF = MesBoutons.Parent 'la partie suivant permet d'identifier l'userform du bouton meme si celui ci est placé sur un frame Do If TypeName(USF) = "Frame" Then Set USF = USF.Parent End If Loop While TypeName(USF) = "Frame" 'appel de la procédure ClicBouton sur l'userform parent Call USF.ClicBouton(MesBoutons.Name) End Sub
Donc si j'ai bien compris, cette fonction se déclenche au click (grace à _Click d'un control qui est listé dans MesBoutons.
Là on commence par trouver le nom de l'userform, si on as mis des boutons dans un frame on leur dit qu'il sont quand même dans l'Userform
puis on appel la fonction Clickbouton en envoyant le nom du bouton concerné.

Ais-je bien compris ?

Merci d'avance et désolé de déterrer ce dossier ... mais si je veut progresser il ne faut pas que je copie des bouts de code mais que je les comprennes ...

06/09/2024, 21h59
ILoveAlphaScorpi

Incroyable ce code! Ca fait deux jours que je suis sur le problème et je viens de tomber dessus! Meilleur sensation ever!

Marrions-nous!

bonsoir
et voici comment on le fait directement dans le userform
car beaucoup l'oubli bien souvent un userform est un module classe avant tout

Code:

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
 
Public WithEvents btx As CommandButton
Dim GroupButton() As New UserForm1
 
Private Sub UserForm_Activate()
Dim toop&, i&, obj
ReDim GroupButton(1 To 4)
 
toop = 20
 
For i = 1 To UBound(GroupButton)
 
    Set obj = Me.Controls.Add("forms.CommandButton.1", "Up" & i)
    With obj
        .Name = "Up " & i
        .Caption = "+"
        .Left = 12
        .Top = toop
        .Width = 18
        .Height = 18
   Set GroupButton(i).btx = obj
   End With
 toop = toop + 20
 Next
Me.Height = toop + 90
End Sub
 
Private Sub btx_Click()
MsgBox "vous avez cliqué sur le bouton " & btx.Name
End Sub