Affecter du code à un bouton par VBA

Bonjour à tous,

Voici le contexte de mon programme VBA : L'utilisateur est sur la page principale du fichier excel, il clique sur un bouton de commande, grâce à un userform cela crée sur une nouvelle page un tableau dépendant des valeurs entrées.

Sur cette nouvelle page, est crée un bouton "importer plan" qui, lorsqu'il clique dessus, lui ouvre le gestionnaire de fichier et il choisit le plan qu'il lui faut (le plan étant différent à chaque page).

Mon problème est le suivant :

Le bouton se crée sans problème à l'endroit voulu sur la nouvelle page. Mais je n'arrive pas du tout à lui affecter du code.

Voici ce que j'ai pour le moment :

ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _

DisplayAsIcon:=False, Left:=50, Top:=20, Width:=100, Height:= _

36.6).Select

ActiveSheet.OLEObjects(1).Object.Caption = "Importer_plan"

Ces 4 premières lignes fonctionnent pour créer le bouton.

La fonction que je souhaite insérer dans le bouton est le suivant :

Sub InsertionImage()

Dim Emplacement As Range

Dim Img As Object

Dim ShapeObj As Shape

'Boucle pour supprimer l'ancienne image

For Each ShapeObj In ActiveSheet.Shapes

If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete

Next ShapeObj

If Application.Dialogs(xlDialogInsertPicture).Show Then

'Définit l'emplacement de l'image

Set Emplacement = Range("E3:H8")

Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

With Img.ShapeRange

'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)

.Name = "Cible"

.LockAspectRatio = msoFalse

.Left = Emplacement.Left

.Top = Emplacement.Top

.Height = Emplacement.Height

.Width = Emplacement.Width

End With

Else

MsgBox "Insertion d'image interrompue."

End If

End Sub

Et de ce que j'ai vu sur d'autres forums, j'ai essayé de m'inspirer de cet exemple pour y affecter du code mais cela ne fonctionne pas :

laMacro = "Private Sub CommandButton.1_Click()" & vbCrLf

laMacro = laMacro & "Cells(1,2).Value=2" & vbCrLf

laMacro = laMacro & "End Sub"

'Ajoute la procédure dans la feuille

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

x = .CountOfLines + 1

.InsertLines x, laMacro

End With

J'espère avoir été bien clair,

Je vous remercie par avance pour essayer de m'aider à résoudre mon problème,

Bonjour,

Testes ce code :

Sub Test()

    Dim Code As String

    ActiveSheet.OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=50, Top:=20, Width:=100, Height:=36.6
    ActiveSheet.OLEObjects(1).Object.Caption = "Importer_plan"

    Code = "Sub CommandButton1_Click()" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "    Dim Emplacement As Range" & vbCrLf
    Code = Code & "    Dim Img As Object" & vbCrLf
    Code = Code & "    Dim ShapeObj As Shape" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "    'Boucle pour supprimer l'ancienne image" & vbCrLf
    Code = Code & "    For Each ShapeObj In ActiveSheet.Shapes" & vbCrLf
    Code = Code & "        If ShapeObj.Name = ""Cible"" Then ActiveSheet.Shapes(""Cible"").Delete" & vbCrLf
    Code = Code & "    Next ShapeObj" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "    If Application.Dialogs(xlDialogInsertPicture).Show Then" & vbCrLf
    Code = Code & "        'Définit l'emplacement de l'image" & vbCrLf
    Code = Code & "        Set Emplacement = Range(""E3:H8"")" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "        With Img.ShapeRange" & vbCrLf
    Code = Code & "            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)" & vbCrLf
    Code = Code & "            .Name = ""Cible""" & vbCrLf
    Code = Code & "            .LockAspectRatio = msoFalse" & vbCrLf
    Code = Code & "            .Left = Emplacement.Left" & vbCrLf
    Code = Code & "            .Top = Emplacement.Top" & vbCrLf
    Code = Code & "            .Height = Emplacement.Height" & vbCrLf
    Code = Code & "            .Width = Emplacement.Width" & vbCrLf
    Code = Code & "        End With" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "    Else" & vbCrLf
    Code = Code & "        MsgBox ""Insertion d'image interrompue.""" & vbCrLf
    Code = Code & "    End If" & vbCrLf
    Code = Code & vbCrLf
    Code = Code & "End Sub"

    With ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule

        .InsertLines .CountOfLines + 2, Code

    End With

End Sub