Affectation de macro existante à bouton dynamique

**richard_sraing** · 13/09/2012, 14h46

Bonjour tout le monde.

Quelqu'un, pourrait-il me dire avec des mots simples, si et comment il est possible d'assigner une macro existante, par exemple, dans un "module1" à un bouton que l'on a créé de manière dynamique dans une feuille de calcul ?

La fonction en question est une fonction censée réaliser la somme d'un grand nombre de cellule, et ce, pour la feuille de calcul liée au bouton. Si le bouton de la feuille4 est cliqué, le calcul doit être fait pour cette dernière.

En vous remerciant pour l'aide que vous pourrez m'apporter dans la compréhension de la mise en place de ma demande, je vous souhaite à tous de passer une bonne fin de journée.

Raph

**richard_sraing** · 13/09/2012, 15h39

Bon, j'avance, lentement mais surement.

J'ai déjà pondu la petite partie de code suivante :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
code = "Private Sub calcul_Click()" & vbCrLf
code = code & "Calcul_Heure (ActiveSheet.Name)" & vbCrLf
code = code & "End Sub" & vbCrLf

qui se trouve dans la partie de code créant mes boutons pour chaque feuille de calcul.

J'ai également, dans le "fichier" "module1", créé ma fonction :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub Calcul_Heure(mois As String)
    MsgBox "Nom de la feuille: " & mois
End Sub

qui ne fait pas grand chose pour l'instant.

Par contre, comment est-ce que j'assigne ma variable "code" à l'action de mon bouton ?

Voici le code de création de mon bouton :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Set bouton = Sheets(i).OLEObjects.Add("Forms.Commandbutton.1")
With bouton
      .Name = "calcul"
      .Left = 1
      .Top = 15
      .Width = 50
      .Height = 25
      .Object.Caption = "Calcul"
End With

J'ai trouvé ceci, mais ne comprend rien à ce que cela fait, et n'ai donc, pas envie de l'utiliser :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        NextLine = .CountOfLines + 1
        .insertlines NextLine, Code
    End With

Code qui de toute manière, ne fonctionne pas 'Code erreur 9'.

En vous remerciant pour l'information manquante.

**richard_sraing** · 17/09/2012, 08h47

Bonjour tout le monde,

Alors je me permet de relancer la discussion, car je ne vois toujours pas le bout du tunnel pour mon problème.

Pour rappel donc, je souhaite, dans une série de feuilles de calculs créées dynamique, ajouter un CommandButton, ce qui fonctionne. A ces boutons, je souhaite assigner une action (qui consistera au calcul des heures de la feuille en question.

Et c'est bien sur ce dernier point que je bloque, l'assignation de la macro au bouton.
Le calcul sera le même à chaque fois, ce qui veux donc dire que je pourrais assigner la macro suivante dans ma boucle (boucle permettant d'initialiser les feuilles de calculs avec les valeurs de départ).

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Set bouton = Sheets(i).OLEObjects.Add("Forms.Commandbutton.1")
' assignation des valeurs du bouton
With bouton
      .Name = "calcul"
      .Left = 150
      .Top = 5
      .Width = 50
      .Height = 25
      .Object.Caption = "Calcul"
End With
 
code = "Private Sub calcul_Click()" & vbCrLf
code = code & "Calcul_Heure (ActiveSheet.Name)" & vbCrLf
code = code & "End Sub" & vbCrLf

Et lorsque je tente d'assigner la macro, avec les quelques lignes ci-dessous, j'obtiens un message d'erreur 9 :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
      NextLine = .CountOfLines + 1
      .insertlines NextLine, code
End With

Voici la partie complète du code en question, se trouvant dans le "module" UFInitialize :

Code VBA :

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
Private Sub cbOK_Click()
Dim rConge As Range, trouve As Range
Dim bouton As OLEObject
Set rConge = config.Range("D2:D15")
If cbConfirm.Value = True Then
    'création des feuilles de calculs pour chaque mois
    Worksheets.Add(After:=Sheets(1)).Name = "Novembre " + tbad.Text
    Worksheets.Add(After:=Sheets(2)).Name = "Décembre " + tbad.Text
    Worksheets.Add(After:=Sheets(3)).Name = "Janvier " + tbaf.Text
    Worksheets.Add(After:=Sheets(4)).Name = "Février " + tbaf.Text
    Worksheets.Add(After:=Sheets(5)).Name = "Mars " + tbaf.Text
    Worksheets.Add(After:=Sheets(6)).Name = "Avril " + tbaf.Text
 
    'il faut à présent initialiser les contenus de chaque feuille
    For i = 2 To Sheets.Count
        If Left(Sheets(i).Name, 3) <> "ouv" And Left(Sheets(i).Name, 3) <> "con" Then
            ' création du bouton
            Set bouton = Sheets(i).OLEObjects.Add("Forms.Commandbutton.1")
            ' assignation des valeurs du bouton
            With bouton
            .Name = "calcul"
            .Left = 150
            .Top = 5
            .Width = 50
            .Height = 25
            .Object.Caption = "Calcul"
            End With
 
            code = "Private Sub calcul_Click()" & vbCrLf
            code = code & "Calcul_Heure (ActiveSheet.Name)" & vbCrLf
            code = code & "End Sub" & vbCrLf
 
            With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
                NextLine = .CountOfLines + 1
                .insertlines NextLine, code
            End With
 
            Sheets(i).Cells(1, 1).Value = Sheets(i).Name
            Sheets(i).Range(Sheets(i).Cells(1, 1), Sheets(i).Cells(1, 4)).Merge
            Sheets(i).Range(Sheets(i).Cells(3, 1), Sheets(i).Cells(3, 4)).Merge
            Sheets(i).Cells(3, 1).Value = "Sous-totaux"
 
            Dim Dico, d
            Dim k As Long
            Dim c As Range
            With Worksheets("config")
                k = 1
                Set Dico = CreateObject("Scripting.dictionary")
                For Each c In Sheets("config").Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
                    If Not Dico.Exists(c.Value) Then Dico.Add c.Value, c.Offset(0, -1).Value
                Next c
                For Each d In Dico.keys
                    Sheets(i).Cells(4, k) = d
                    k = k + 1
                Next d
                Set Dico = Nothing
            End With
 
            ' en x,1 il faut placer les noms des ouvriers
            j = 2
            While Not IsEmpty(ouvriers.Cells(j, 1).Value)
                With Sheets(i).Cells(j + 2, 5)
                    .Value = ouvriers.Cells(j, 1).Value
                    .Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                End With
                j = j + 1
            Wend
            ' en 2,x il faut placer les dates
            Dim maDate As Date
            cell1 = Left(Sheets(i).Cells(1, 1).Value, 3)
            annee = Right(Sheets(i).Cells(1, 1).Value, 4)
            mois = 0
            Select Case cell1
                Case "Nov": mois = 11
                Case "Déc": mois = 12
                Case "Jan": mois = 1
                Case "Fév": mois = 2
                Case "Mar": mois = 3
                Case "Avr": mois = 4
            End Select
            maDate = CDate("01/" & mois & "/" & annee)
            maDate = DateAdd("m", 1, maDate)
            maDate = DateAdd("d", -1, maDate)
            compteur = 6
            For j = 1 To Day(maDate)
                Dim dateJour As Date
                dateJour = CDate(j & "/" & mois & "/" & annee)
                Set trouve = rConge.Find(what:=dateJour)
                ' place la date du jour dans la cellule correspondante (ligne 2)
                Sheets(i).Cells(2, compteur).Value = WeekdayName(Weekday(dateJour, 2)) & " " & j
                If trouve Is Nothing Then
                    ' Si samedi ou dimanche, pas de fusion de cellule
                    If Weekday(dateJour) = 1 Or Weekday(dateJour) = 7 Then
                        Sheets(i).Cells(2, compteur).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                        Sheets(i).Cells(2, compteur).Borders(xlEdgeRight).Weight = xlThick
                        Sheets(i).Cells(3, compteur).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                        Sheets(i).Cells(3, compteur).Borders(xlEdgeRight).Weight = xlThick
                        Sheets(i).Range(Sheets(i).Cells(3, compteur), Sheets(i).Cells(24, compteur)).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                        Sheets(i).Range(Sheets(i).Cells(3, compteur), Sheets(i).Cells(24, compteur)).Borders(xlEdgeRight).Weight = xlThick
 
                        compteur = compteur + 1
                    ' si un jour de semaine normal, fusion des cellules (nombres de tranches horaires)
                    Else
                        Sheets(i).Range(Sheets(i).Cells(2, compteur), Sheets(i).Cells(2, compteur + 3)).Merge
                        ' Mise en forme de la cellule de la date
                        Sheets(i).Cells(2, compteur).HorizontalAlignment = xlCenter
                        Sheets(i).Cells(2, compteur + 3).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                        Sheets(i).Cells(2, compteur + 3).Borders(xlEdgeRight).Weight = xlThick
                        ' insertion des tranches horaires dans les cellules correspondantes
                        Sheets(i).Cells(3, compteur + 0).Value = config.Cells(2, 1).Value
                        Sheets(i).Cells(3, compteur + 1).Value = config.Cells(3, 1).Value
                        Sheets(i).Cells(3, compteur + 2).Value = config.Cells(4, 1).Value
                        Sheets(i).Cells(3, compteur + 3).Value = config.Cells(5, 1).Value
                        Sheets(i).Range(Sheets(i).Cells(3, compteur + 3), Sheets(i).Cells(24, compteur + 3)).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                        Sheets(i).Range(Sheets(i).Cells(3, compteur + 3), Sheets(i).Cells(24, compteur + 3)).Borders(xlEdgeRight).Weight = xlThick
                        compteur = compteur + 4
                    End If
                ' nous sommes un jour férié (spécifié dans la feuille config)
                Else
                    Sheets(i).Cells(3, compteur).Value = "Férié"
                    Sheets(i).Cells(2, compteur).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                    Sheets(i).Cells(2, compteur).Borders(xlEdgeRight).Weight = xlThick
                    Sheets(i).Cells(3, compteur).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                    Sheets(i).Cells(3, compteur).Borders(xlEdgeRight).Weight = xlThick
                    Sheets(i).Range(Sheets(i).Cells(3, compteur), Sheets(i).Cells(24, compteur)).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
                    Sheets(i).Range(Sheets(i).Cells(3, compteur), Sheets(i).Cells(24, compteur)).Borders(xlEdgeRight).Weight = xlThick
                    compteur = compteur + 1
                End If
            Next
            ' indique que les cellules ajuste la largeur automatiquement
            Sheets(i).Columns.AutoFit
            ' spécifie le format "hh:mm" pour les cellules contenant les heures
            Sheets(i).Range("A5:D25").NumberFormat = "hh:mm"
            Sheets(i).Range("F4:DB25").NumberFormat = "hh:mm"
        End If
    Next
    'activation de la feuille de calcul Accueil
    Sheets(1).Activate
 
    'fermeture et déchargement de la boite de dialogue
    UFInitialize.Hide
    Unload UFInitialize
End If
End Sub

En vous remerciant pour l'aide qu'il vous sera possible de m'apporter, je vous souhaite à tous, de passer une bonne journée.

p.s.: toute remarques me permettant d'optimiser le code est la bienvenue aussi, car je le répète, je suis débutant en développement VBA.

**richard_sraing** · 20/09/2012, 11h44

Personne pour m'aider à comprendre pourquoi cela ne fonctionne pas ?

**fring** · 20/09/2012, 12h18

Bonjour,

Remplace cette ligne de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule

par celle-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With ActiveWorkbook.VBProject.VBComponents(Sheets(i).CodeName).CodeModule

**richard_sraing** · 20/09/2012, 13h05

Excellent,

Merci pour l'information.

J'avais dès lors une dernière erreur, que je viens de corriger, et voici donc le code complet de l'assignation de mes macros aux boutons :

Code VBA :

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
Set bouton = Sheets(i).OLEObjects.Add("Forms.Commandbutton.1")
' assignation des valeurs du bouton
With bouton
.Name = "calcul"
.Left = 250
.Top = 5
.Width = 50
.Height = 25
.Object.Caption = "Calcul"
End With
 
code = "Private Sub calcul_Click()" & vbCrLf
code = code & "Call Calcul_Heure ()" & vbCrLf
code = code & "End Sub" & vbCrLf
 
'With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
With ActiveWorkbook.VBProject.VBComponents(Sheets(i).CodeName).CodeModule
    NextLine = .CountOfLines + 1
    .insertlines NextLine, code
End With

Affectation de macro existante à bouton dynamique [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager