Modifier le code d'un bouton

Version imprimable

Bonjour,

J'ai une macro liée à un bouton qui me génère une nouvelle feuille dans mon classeur.
Dans cette nouvelle feuille, je crée un bouton pour lequel je voudrai insérer un bout de code.

Ce que j'ai réussi à faire :
- Générer la nouvelle feuille
- Créer mon bouton
- Modifier le nom du bouton et le texte associé

Ce que je n'ai pas réussi à faire :
- Modifier le code VBA du bouton

Voici mon bout de code pour créer le bouton :

Code:

1
2
3
4
5
6
7
8
9
10
                newSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
                    , DisplayAsIcon:=False, Left:=1, Top:=1, Width:=72, Height:=24). _
                    Select
 
                X = ActiveSheet.OLEObjects.Count 'compter le nombre de boutons existants dans la feuille
 
                'option nommer l'objet
                ActiveSheet.OLEObjects(X).name = "GenerateXML"
                'texte sur le bouton
                ActiveSheet.OLEObjects(X).Object.Caption = "Generate XML"

Voici le bout de code pour modifier le code du bouton :

Code:

1
2
3
4
5
6
7
8
9
10
                Code = "Sub GenerateXML_Click()" & vbCrLf
                Code = Code & "  ModuleOngletsImportation.GenerateXML2" & vbCrLf
                Code = Code & "End Sub"
 
                With ActiveWorkbook
                    MsgBox ("OK")
                    .VBProject.VBComponents(ActiveSheet.name).CodeModule.AddFromString (Code)
                    'NextLine = .CountOfLines + 1
                    '.insertlines NextLine, Code
                End With

Je n'arrive pas à faire fonctionner cette seconde partie.

Y aurait-il quelqu'un pour m'aider ?

Pour insérer une macro par le code, jète un oeil ici. Si ça ne te suffit pas, tu dis ;)
A+

Adapté à ton code, ça devrait donner quelque chose conne ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit

Sub EcrireDuCodeNimporteOu()
Dim i, LeCode(1 To 3)
Dim NomClasseur As String, NomFeuil As String
Dim Wb As Workbook
NomClasseur = ActiveWorkbook.Name

    NomFeuil = ActiveSheet.Name 'A ADAPTER
                LeCode(1) = "Sub GenerateXML_Click()"
                LeCode(2) = "  ModuleOngletsImportation.GenerateXML2"
                LeCode(3) = "End Sub"

    Set Wb = Workbooks(NomClasseur)
    With Wb.VBProject.VBComponents(NomFeuil).CodeModule
        For i = .CountOfLines To 1 Step -1
            .DeleteLines i
            DoEvents
        Next
        For i = 1 To UBound(LeCode)
            .InsertLines i, LeCode(i)
        Next
    End With

Bonne journée

Merci pour la rapidité de la réponse.

Voici mon compte arrangé :

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
    If isSheetExist(catName) = False Then
      'l'onglet n'existe pas on le crée
      Set newSheet = Sheets.Add(, Worksheets(Worksheets.Count))
      newSheet.name = catName
 
                'Création du bouton
                newSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
                    , DisplayAsIcon:=False, Left:=1, Top:=1, Width:=72, Height:=24). _
                    Select
 
                X = ActiveSheet.OLEObjects.Count 'compter le nombre de boutons existants dans la feuille
 
                'option nommer l'objet
                ActiveSheet.OLEObjects(X).name = "GenerateXML"
                'texte sur le bouton
                ActiveSheet.OLEObjects(X).Object.Caption = "Generate XML"
 
                'Céation du bout de code
                NomClasseur = ActiveWorkbook.name
                NomFeuil = ActiveSheet.name
                LeCode(1) = "Sub GenerateXML_Click()"
                LeCode(2) = "  ModuleOngletsImportation.GenerateXML2"
                LeCode(3) = "End Sub"
                With ActiveWorkbook.VBProject.VBComponents(NomFeuil).CodeModule
                    For j = .CountOfLines To 1 Step -1
                        .DeleteLines j
                        DoEvents
                    Next
                    For j = 1 To UBound(LeCode)
                        .InsertLines j, LeCode(j)
                    Next
                End With
                'Workbooks(NomClasseur).Worksheets(2).Select
 
 
      ActiveWindow.Zoom = 75
    End If

Par contre j'ai une erreur à l'exécution de cette commande :

Code:

With ActiveWorkbook.VBProject.VBComponents(NomFeuil).CodeModule

Et voici l'erreur que j'ai :

Citation:

Erreur d'exécution '9'
L'indice n'appartien pas à la sélection

L'indice, je suppose que c'est "NomFeuil" mais il semble correct quand je l'affiche dans une MsgBox

Une idée sur la résolution de cette erreur ?

Merci d'avance.

Essaie en instanciant le classeur
Code:

1 2 Set Wb = Workbooks(NomClasseur) With Wb.VBProject.VBComponents(NomFeuil).CodeModule
et n'oublie pas le "end With" ;)