Création automatique d'un bouton + association de code VBA

Version imprimable

Bonjour,

Comme indiqué dans le titre, je cherche à réaliser une macro qui me permettrait de créer un bouton dans un autre classeur excel, à une place déterminée (vers la cellule B500) et de lui attribuer du code VBA (très simple, il s'agirait juste de UserForm1.Show, sachant que l'userform a déjà été exportée vers le fichier cible).

J'ai tenté le code suivant :
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 Dim Classeur As Workbook Dim oOLE As OLEObject Dim X As Byte Dim Code$ 'On crée le code associé Code = "Sub CommandButton1_Click()" & vbCrLf Code = Code & "MsgBox ""Coucou XLD""" & vbCrLf Code = Code & "End Sub" Set Classeur = Workbooks("Echelles " & v & " " & m & " " & a) 'à adapter, ou workbooks.add si on crée le fichier With Classeur With .Worksheets("NOSTRI_" & v) X = .OLEObjects.Count Set oOLE = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=30.75, Top:=6423.75, Width:=132, Height:=48.75) End With With oOLE .Name = "CommandButton" & X + 1 .Object.Caption = "Echelles KO" End With With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule .InsertLines .CreateEventProc("Click", "Commandbutton" & X + 1) + 1, Code End With End With
Mais le problème est qu'au niveau de "ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.InsertLines .CreateEventProc("Click", "Commandbutton" & X + 1) + 1, Code" (vers les dernières lignes), Excel me dit que mon "subscript is out of range".

Or je ne vois pas ce qui pèche, puisque l'emplacement cible est indiqué (selon moi).

Pourriez vous m'indiquer ce qui pose problème?

Merci par avance de l'aide que vous pourriez m'apporter.

26/07/2010, 13h27
zyhack
Bonjour

J'ai du mal à comprendre, puisque c'est dans l'autre classeur que tu veux écrire le code pourquoi utiliser ThisWorkbook, ce ne serais pas plutot
Code:

1 2 3 With .VBProject.VBComponents(ActiveSheet.Name).CodeModule .InsertLines .CreateEventProc("Click", "Commandbutton" & X + 1) + 1, Code End With

Bonjour,

Essaie ainsi :

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
Sub ee()
Dim Classeur As Workbook
Dim oOLE As OLEObject
Dim X As Byte
Dim Feuille As Worksheet
Dim Code$
Dim ProchLigne&
 
Set Classeur = Workbooks("Echelles " & v & " " & m & " " & a) 'à adapter, ou workbooks.add si on crée le fichier
 
With Classeur
    Set Feuille = .Worksheets("NOSTRI_" & v)
    With Feuille
        Set oOLE = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, Left:=30.75, Top:=6423.75, Width:=132, Height:=48.75)
            X = .OLEObjects.Count
    End With
    Code = "Sub CommandButton" & X + 1 & "_Click()" & vbCrLf
    Code = Code & "MsgBox ""Coucou XLD""" & vbCrLf
    Code = Code & "End Sub"
    With oOLE
        .Name = "CommandButton" & X + 1
        .Object.Caption = "Echelles KO"
    End With
    With .VBProject.VBComponents(Feuille.CodeName).CodeModule
        ProchLigne = .CountOfLines + 1
        .InsertLines ProchLigne, Code
    End With
End With
End Sub

Bonne soirée

En plus il faut utiliser Codename au lieu du name
dans code tu as commandbutton1_click
et tu l'insère dans commandbuttonX+1 en plus avec 2 titres de sub
je pense (pas testé)

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
Dim Classeur As Workbook
Dim oOLE As OLEObject
Dim X As Byte
Dim Code As String
 
Set Classeur = Workbooks("Echelles " & v & " " & m & " " & a) 'à adapter, ou workbooks.add si on crée le fichier
With Classeur
    With .Worksheets("NOSTRI_" & v)
        X = .OLEObjects.Count
        Set oOLE = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=30.75, Top:=6423.75, Width:=132, Height:=48.75)
    End With
 
    With oOLE
        .Name = "CommandButton" & X + 1
        .Object.Caption = "Echelles KO"
    End With
    Set oOLE = Nothing
 
'On crée le code associé
    Code = "Sub CommandButton" & X + 1 & "_Click()" & vbCrLf
    Code = Code & "MsgBox ""Coucou XLD""" & vbCrLf
    Code = Code & "End Sub"
 
    With .VBProject.VBComponents(.Worksheets("NOSTRI_" & v).CodeName).CodeModule
        .InsertLines .CountOfLines + 1, Code
    End With
End With
Set Classeur = Nothing
End Sub

26/07/2010, 14h06
Brendalf

Bonjour,

Tout d'abord merci pour la réponse.

Le fait est que j'avais testé au début juste avec

Code:

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

(et que je viens de réessayer), mais mon script est toujours "out of range".

Je suppose donc, vu l'intitulé de l'erreur, qu'il s'agit tout simplement d'un emplacement mal indiqué, apparemment sur cette ligne, mais... rien à faire.
J'ai également testé avec, à la place de "ActiveSheet", "Sheets("Nom"). Toujours sans effet.

Si vous aviez cependant une autre solution pour créer mon bouton et lui assigner un code vba, je suis preneur.

Merci d'avance.

EDIT : Merci beaucoup, cela fonctionne parfaitement avec Codename. Vous m'ôtez une grosse épine du pied, et un problème qui me bloquait depuis un certain moment. Merci encore, bonne journée