Créer un bouton dynamiquement excel via VBA

Sub CreerMenu()

    Dim X As Byte
    Dim i, BU_number As Long
    Dim Code As String
    Dim NextLine As String
    Dim oOLE As OLEObject
    
    Sheets("Menu").Select
    Range("A1").Select
    i = 1
    Do While Cells(i, 1).Value <> "XXX"
        i = i + 1
    Loop
    i = i + 1
    BU_number = Cells(i, 1)

    'Workbooks.Add 'creer classeur
    Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="F­orms.CommandButton.1", _
        Link:=False, DisplayAsIcon:=False, Left:=340, Top:=30, Width:=100, Height:=30)

    'Left position bouton par rapport au bord gauche de la feuille
    'Top position bouton par rapport au haut de la feuille
    'Width largeur bouton
    'Height hauteur bouton

    X = ActiveSheet.OLEObjects.Count 'compter le nombre de boutons existants dans la feuille

    'option nommer l'objet
    oOLE.Name = "CommandButton" & X
    'texte sur le bouton
    ActiveSheet.OLEObjects(X).Object.Caption = "BU " & X
    Code = "Sub CommandButton" & X & "_Click()" & vbCrLf
    Code = Code & "Sheets(""feuil2"").select" & vbCrLf
    Code = Code & "End Sub"

    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).Code­Module
        NextLine = .CountOfLines + 1
        .insertlines NextLine, Code
    End With

End Sub

With myCommandButtonDetail
            .Name = "CommandButtonDetail_" & iNbReappro
            .OnAction = "'Nom de la routine a appeller'"
            '-- le reste des param
End With

Sub TestCreationBouton()

    Dim myCommandButtonDetail  As CommandButton
    Dim iNbReappro As Integer, NextLine As Integer
    Dim strCode As String
    
    iNbReappro = 1
    
    Set myCommandButtonDetail = GestionMeuleForm.MultiPage1.Pages("Page4").CalculB­esoinFrame.Controls.Add _
        ("Forms.CommandButton.1", "CommandButtonDetail_" & iNbReappro)
    
    With myCommandButtonDetail
        .Name = "CommandButtonDetail_" & iNbReappro
        .Caption = "Run"
        .Top = 50
        .Left = 100
    End With

    strCode = ""
    strCode = strCode & "Private Sub CommandButtonDetail_" & iNbReappro & "_Click()" & vbCrLf & vbCrLf
    strCode = strCode & "'    Load DetailReapproForm" & vbCrLf
    strCode = strCode & "'    GestionMeuleForm.Hide" & vbCrLf
    strCode = strCode & "'    DetailReapproForm.Show" & vbCrLf
    strCode = strCode & "    Msgbox" & """" & "Réussi" & vbCrLf & vbCrLf
    strCode = strCode & "End Sub" & Chr(13)
    
    With ThisWorkbook.VBProject.VBComponents("GestionMeuleForm&q­uot;).CodeModule
        NextLine = .CountOfLines + 1
        .InsertLines NextLine, strCode
    End With


End Sub
'

Configuration: Windows XP
Internet Explorer 6.0

Configuration: Windows XP
Internet Explorer 6.0

Configuration: Windows XP
Internet Explorer 6.0

Sub ChercheFeuille()
    
    Dim VBP As Variant
    Dim VBC As VBComponent
    Dim Message As String
    
    On Error Resume Next
    Set VBP = ActiveWorkbook.VBProject
    Message = ""
    With VBP
        For Each VBC In .VBComponents
            'Message = Message & vbLf & VBC.Name
            Select Case VBC.Type
                'Case 1: Message = Message & vbLf & "Module "
                'Case 2: Message = Message & vbLf & "Class Module "
                'Case 3: Message = Message & vbLf & "UserForm "
                Case 100: Message = Message & vbLf & "Document Module " & VBC.Name
            End Select
        Next VBC
    End With
    MsgBox Message
    
End Sub
'

Configuration: Windows XP
Internet Explorer 6.0

Option Explicit

Private Sub Groupe_Click()
    Call Module1.Choix_Feuille(Me.Groupe.Name)
End Sub

Option Explicit

Sub Choix_Feuille(Nom_Feuille As String)

    Nom_Feuille = Sheets("Base").Groupe.Name

    If (Feuille_Existe(Nom_Feuille)) Then
        Sheets(Nom_Feuille).Select
        Range("A1").Select
    Else
        MsgBox "Impossible, la feuille n'existe pas"
    End If

End Sub
'

Public Function Feuille_Existe(Feuille As String) As Boolean
    Dim wsFeuille As Worksheet
    Feuille_Existe = False
    For Each wsFeuille In Worksheets
        If (wsFeuille.Name = Feuille) Then
            Feuille_Existe = True
            Exit For
        End If
    Next wsFeuille
End Function
'