génération dynamique de code

Question

Salut à tous, 

dites je cherche à créer du code qui créé des boutons de commande et associe à ces boutons une macro 

j'ai trouvé ce code, mais vba plante sur la ligne où j'ai marqué Erreur ...




Sub AjouteSerieBoutonsFormulaires()
    Dim i As Byte
    Dim x As Integer
    Dim Code As String
    Dim S As Shape
    
    For i = 2 To 11
        'création des boutons dans la Feuil1
        With Feuil1
            Set S = .Shapes.AddFormControl(xlButtonControl, .Cells(i, 2).Left, .Cells(i, 2).Top, _
                .Cells(i, 2).Width, .Cells(i, 2).Height)
        End With
        
        'Définit le texte qui va s'afficher dans le bouton.
        S.TextFrame.Characters.Caption = "bouton " & i
        'Attache une macro au bouton
        S.OnAction = "MacroBouton"
    Next i

    'Crée dynamiquement la macro attachée aux boutons.
    Code = "Sub MacroBouton" & vbCrLf
    Code = Code & "MsgBox Application.Caller" & vbCrLf
    Code = Code & "End Sub"
    
    'Insertion de la macro dans le **Module1**.
    '(adaptez le nom du module si nécessaire)
    With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule 'Erreur !!!
        x = .CountOfLines + 1
        .InsertLines x, Code
    End With

End Sub



Quelqu'un aurait une idée ???


nitho l'amateur

cs_nitho · Answer

Pareil pour la  version ActiveX



Sub AjoutCommandButton_Feuille()
    Dim Ws As Worksheet
    Dim Obj As OLEObject
    Dim laMacro As String
    Dim x As Integer
    
    'Ajout feuille
    Set Ws = Sheets.Add
        
    'Ajout CommandButton dans la feuille
    Set Obj = Ws.OLEObjects.Add("Forms.CommandButton.1")
    With Obj
        .Left = 50 'position horizontale
        .Top = 50 'position verticale
        .Width = 140 'largeur
        .Height = 30 'hauteur
        .Object.BackColor = RGB(235, 235, 200) 'Couleur de fond
        .Object.Caption = "Supprimer données feuille"
    End With
    
    'Paramètres pour la création de la macro:
    '(suppression contenu cellules)
    laMacro = "Sub CommandButton1_Click()" & vbCrLf
    laMacro = laMacro & "Cells.Clear" & vbCrLf
    laMacro = laMacro & "End Sub"
    
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule 'Erreur !!!
        x = .CountOfLines + 1
        .InsertLines x, laMacro
    End With
End Sub




nitho l'amateur

Génération dynamique de code

1 réponse

Votre réponse

Discussions similaires