Créer un CommandButton dynamique

StrikeBEH

XLDnaute Occasionnel
Bonjour à tous,
J'ai un "petit" soucis à résoudre et après avoir chercher une solution pendant de nombreuses heures, je n'ai rien trouvé !
Je m'en remets donc à vous...

Plus en détails, j'essaye de faire en VBA, un "logiciel" de compte banquaire.
A l'ouverture du classeur, il n'y a que la page "Accueil", les autres pages pouvant exister sont supprimées.
Sur cette page et si le "logiciel" est ouvert pour la première fois, j'ouvre un UserForm afin de le personnaliser.
Les infos sont ensuite récapitulées sur la page "Accueil".
Puis ensuite, je crée une nouvelle page en fonction du mois et de l'année (ex: jan 2014).
Jusque la tout va bien...
Mais ensuite, je souhaiterai ajouter sur la page "jan 2014" un CommandButton "Nouvelle saisie" avec le code généré automatiquement pour gérer le "click"...
Et la, j'avoue, je GALERE !!!

Peut-être y aura-t-il une âme charitable, afin de me mettre sur la voie...

Par avance, merci à vous !

P.S.
J'utilise le code suivant pour créer une nouvelle feuille...
' Si Document non vierge
If Sheets(1).Name = "Accueil" Then
' Création Feuille pour mois en cours
For i = 1 To Sheets.Count
If Sheets(i).Name = (vMois & " " & vAn) Then MenCours = 1
Next i

If MenCours = 0 Then
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = (vMois & " " & vAn)

With ActiveWorkbook.Sheets(vMois & " " & vAn).Tab
.Color = vbCyan
.TintAndShade = 0
End With
End If
 

Lone-wolf

XLDnaute Barbatruc
Re : Créer un CommandButton dynamique

Bonsoir StrikeBEH,

Voici une façon de faire, mais avec un module de classe ça serait mieux pour gerer les actions à exécuter.

Code:
Private Sub Workbook_Open()
Dim oOLE As OLEObject
Dim x As Long
Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
        Link:=False, DisplayAsIcon:=False, Left:=340, Top:=30, Width:=100, Height:=30)
      
 x = ActiveSheet.OLEObjects.Count

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

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


Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.OLEObjects.Delete
End Sub



A+ :cool:
 
Dernière édition:

StrikeBEH

XLDnaute Occasionnel
Re : Créer un CommandButton dynamique

Merci pour votre réponse !
J'ai testé dans un classeur "vierge" et ça fonctionne parfaitement !!!
Mais et je m'en excuse, vu mon peu de connaissances en VBA, le code que vous m'avez indiqué, je le mets où ???
Dans "ThisWorkbook" ou dans un module ???
 

Lone-wolf

XLDnaute Barbatruc
Re : Créer un CommandButton dynamique

Bonjour StrikeBEH,

EDIT: exemple d'un bouton et macro dynamique.

Code:
Private Sub Workbook_Open()
Dim oOLE As OLEObject
Dim x As Long

Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                Link:=False, DisplayAsIcon:=False, Left:=760, Top:=20, Width:=100, Height:=30)
             

            oOLE.Name = "CmdSaisie"
             ActiveSheet.OLEObjects(1).Object.Caption = "Nouvelle saisie"
           Code = "Sub CmdSaisie_Click()" & vbCrLf
           Code = Code & "With Activesheet" & vbCrLf
           Code = Code & ".Range(""c3"").Value = 10" & vbCrLf
           Code = Code & ".Range(""c4"").Value = 10" & vbCrLf
           Code = Code & ".Range(""c5"").Value = WorksheetFunction.Sum(.Range(""c3"").Value, .Range(""c4"").Value)" & vbCrLf
           Code = Code & "End With" & vbCrLf
           Code = Code & "End Sub"

            With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.Name).codemodule
                NextLine = .CountOfLines + 1
                .insertlines NextLine, Code
            End With
        End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
With Feuil1.Parent.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
            .deleteLines .ProcStartLine("CmdSaisie_Click", 0), .ProcCountLines("CmdSaisie_Click", 0)
        End With
        Feuil1.OLEObjects.Delete
ActiveWorkbook.Save
End Sub



A+ :cool:
 
Dernière édition:

StrikeBEH

XLDnaute Occasionnel
Re : Créer un CommandButton dynamique

Bonsoir,
Pardon de passer pour un "boulet", mais j'ai essayé de modifier le code ainsi (le code se trouve dans le module "Accueil"):

If MenCours = 0 Then
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = (vMois & " " & vAn)


With ActiveWorkbook.Sheets(vMois & " " & vAn).Tab
.Color = vbCyan
.TintAndShade = 0
End With


Dim oOLE As OLEObject
Dim x As Long
Dim Code$
Dim NextLine$


Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=760, Top:=20, Width:=100, Height:=30)

oOLE.Name = "CmdSaisie"
ActiveSheet.OLEObjects(1).Object.Caption = "Nouvelle saisie"
Code = "Sub CmdSaisie_Click()" & vbCrLf
Code = Code & "With Activesheet" & vbCrLf
Code = Code & ".Range(""c3"").Value = 10" & vbCrLf
Code = Code & ".Range(""c4"").Value = 10" & vbCrLf
Code = Code & ".Range(""c5"").Value = WorksheetFunction.Sum(.Range(""c3"").Value, .Range(""c4"").Value)" & vbCrLf
Code = Code & "End With" & vbCrLf
Code = Code & "End Sub"


With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.Name).codemodule
NextLine = .CountOfLines + 1
.insertlines NextLine, Code
End With


Application.DisplayAlerts = False


With Feuil1.Parent.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
.deleteLines .ProcStartLine("CmdSaisie_Click", 0), .ProcCountLines("CmdSaisie_Click", 0)
End With
Feuil1.OLEObjects.Delete
ActiveWorkbook.Save
End If

et en retour, j'ai le message "Erreur 9" "L'indice n'appartient pas à la sélection" et j'ai la ligne:
With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.Name).codemodule
qui est surlignée en jaune !!!

grrr, ça m'énerve !;) tout ça pour un foutu bouton de m... :mad: ;)
 

Lone-wolf

XLDnaute Barbatruc
Re : Créer un CommandButton dynamique

Bonsoir StrikeBEH,

Qu'elle est votre version Excel?.

Vous avez ajouté votre procédure avec la procédure que j'ai mis comme exemple. Il faut remplacer les lignes entre parenthèse de mon exemple par les lignes de votre code. Ensuite copier tout le code dans Workbook_Open comme dans le message précédent. Si vous avez un problème, n'ésitez pas revenir.



A+ :cool:
 

Lone-wolf

XLDnaute Barbatruc
Re : Créer un CommandButton dynamique

Re StrikeBEH,


Bon d'accord, je vais faire le gentil.

Voici le code d'après l'exemple que vous m'avez montré.


Code:
Private Sub Workbook_Open()
Dim oOLE As OLEObject

 Sheets(2).Activate
 
 Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                Link:=False, DisplayAsIcon:=False, Left:=760, Top:=20, Width:=100, Height:=30)

         
            oOLE.Name = "CmdSaisie"
            ActiveSheet.OLEObjects(1).Object.Caption = "Nouvelle saisie"
           Code = "Sub CmdSaisie_Click()" & vbCrLf
           Code = Code & "If MenCours = 0 Then" & vbCrLf
           Code = Code & "Sheets.Add After:=Sheets(Sheets.Count)" & vbCrLf
           Code = Code & "ActiveSheet.Name = (vMois &"" "" & vAn)" & vbCrLf
           Code = Code & "End If" & vbCrLf & vbCrLf
           Code = Code & "With ActiveWorkbook.Sheets(vMois &"" ""& vAn).Tab" & vbCrLf
           Code = Code & ".Color = vbCyan" & vbCrLf
           Code = Code & ".TintAndShade = 0" & vbCrLf
           Code = Code & "End With" & vbCrLf
           Code = Code & "End Sub"
          
            With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
                NextLine = .CountOfLines + 1
                .insertlines NextLine, Code
            End With      
        End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
With Feuil2.Parent.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
            .deleteLines .ProcStartLine("CmdSaisie_Click", 0), .ProcCountLines("CmdSaisie_Click", 0)
        End With
        Feuil2.OLEObjects.Delete
ActiveWorkbook.Save
End Sub




'Renommer les feuilles 1 à 1 (mois et année)
'La première est Accueil

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim ns As Long, m As Integer, mois As String

For m = 1 To Sheets.Count - 1
ns = 30 * m
mois = Format(ns, "mmm") & "  " & Year(Date)
Next m
ActiveSheet.Name = mois
End Sub


Faites un test.



A+ :cool:
 
Dernière édition:

StrikeBEH

XLDnaute Occasionnel
Re : Créer un CommandButton dynamique

Bonjour Lone-wolf,

Tout d'abord je me permets de vous remercier pour votre patience... :p
J'ai étudier attentivement votre code (je me suis un peu arraché les cheveux et grace à vous, je suis presque chauve !!! :D) et en fait j'ai du adapter le "code" associé au bouton pour que cela m'ouvre un UserForm permettant à l'utilisateur de saisir la date, le crédit-débit ainsi que le libellé pour chaque opération.

Une chose m'a induit en erreur, et ce dès la première ligne... le fameux "Private Sub Workbook_Open()" !
Et donc j'avais eu le réflexe (mauvais...) de mettre le tout dans "ThisWorkbook" !!! arf... quel c...
Mais c'est en faisant des erreurs que l'on apprend, non ?
J'ai donc adapté tout cela à ma sauce et cela donne ceci...

Code:
If MenCours = 0 Then
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = (vMois & " " & vAn)

    With ActiveWorkbook.Sheets(vMois & " " & vAn).Tab
        .Color = vbCyan
        .TintAndShade = 0
    End With

    Dim oOLE As OLEObject
    Dim Code$, NextLine&
    Sheets(vMois & " " & vAn).Activate
 
    Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                Link:=False, DisplayAsIcon:=False, Left:=760, Top:=20, Width:=100, Height:=30)

    oOLE.Name = "CmdSaisie"
    ActiveSheet.OLEObjects(1).Object.Caption = "Nouvelle saisie"
    Code = "Sub CmdSaisie_Click()" & vbCrLf
    Code = Code & "UserForm_Saisie.Show" & vbCrLf
    Code = Code & "End Sub"
          
    With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
        NextLine = .CountOfLines + 1
        .insertlines NextLine, Code
    End With

En effet, le bouton doit permettre l'ouverture d'un UserForm et non la création d'une nouvelle feuille...
Je me suis surement mal exprimé dans ma recherche, mais j'ai réussi à me débrouiller pour adapter...
Encore mille merci à vous et bonne continuation.
Cordialement,

P.S. Je ne me sers pas du code suivant et cela semble fonctionner correctement sans cela...
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
With Feuil2.Parent.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
            .deleteLines .ProcStartLine("CmdSaisie_Click", 0), .ProcCountLines("CmdSaisie_Click", 0)
        End With
        Feuil2.OLEObjects.Delete
ActiveWorkbook.Save
End Sub

'Renommer les feuilles 1 à 1 (mois et année)
'La première est Accueil

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim ns As Long, m As Integer, mois As String

For m = 1 To Sheets.Count - 1
ns = 30 * m
mois = Format(ns, "mmm") & "  " & Year(Date)
Next m
ActiveSheet.Name = mois
End Sub
 

StrikeBEH

XLDnaute Occasionnel
Re : Créer un CommandButton dynamique

Re bonjour,
en poursuivant l'écriture de mon code, je me suis rendu compte qu'il me fallait un deuxième bouton dynamique nommé "Terminé"...
J'ai donc repris le code pour le premier bouton en le modifiant, ce qui donne:
If MenCours = 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = (vMenCours)
ActiveWorkbook.Sheets(vMenCours).Tab.Color = vbCyan
ActiveWindow.DisplayGridlines = False ' Désactive le cadrillage

Dim oOLE As OLEObject
Dim Code$, NextLine&
Sheets(vMenCours).Activate

Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=215, Top:=3, Width:=90, Height:=25)

oOLE.Name = "CmdSaisie"
ActiveSheet.OLEObjects(1).Object.FontBold = True
ActiveSheet.OLEObjects(1).Object.Caption = "Nouvelle saisie"
Code = "Sub CmdSaisie_Click()" & vbCrLf
Code = Code & "UserForm7_Saisie.Show" & vbCrLf
Code = Code & "End Sub"

With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
NextLine = .CountOfLines + 1
.insertlines NextLine, Code
End With

Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.2", _
Link:=False, DisplayAsIcon:=False, Left:=240, Top:=3, Width:=70, Height:=25)

oOLE.Name = "CmdTermine"
ActiveSheet.OLEObjects(2).Object.FontBold = True
ActiveSheet.OLEObjects(2).Object.Caption = "Terminé"
Code = "Sub CmdTermine_Click()" & vbCrLf
Code = Code & "MsgBox" & vbCrLf
Code = Code & "End Sub"

With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
NextLine = .CountOfLines + 1
.insertlines NextLine, Code
End With



End If
Mais ça ne fonctionne pas !!! Cela aurait été trop beau !
Ca me dit "Impossible d'insérer un objet, erreur 1004"

Merci de m'éclairer à nouveau...
 

StrikeBEH

XLDnaute Occasionnel
Re : Créer un CommandButton dynamique

En cherchant un peu, car j'aime bien rechercher aussi par moi_même la solution, ça m'aide à mieux comprendre...
J'ai modifié le code ainsi et ça fonctionne ! ;)
Et si en plus ça peut en aider d'autres...

Code:
If MenCours = 0 Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = (vMenCours)
    ActiveWorkbook.Sheets(vMenCours).Tab.Color = vbCyan
    ActiveWindow.DisplayGridlines = False ' Désactive le cadrillage
  
    Dim oOLE As OLEObject
    Dim Code$, NextLine&
    
    Sheets(vMenCours).Activate

    Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, Left:=205, Top:=4, Width:=85, Height:=25)

    oOLE.Name = "CmdSaisie"
    ActiveSheet.OLEObjects(1).Object.FontBold = True
    ActiveSheet.OLEObjects(1).Object.Caption = "Nouvelle saisie"
    Code = "Sub CmdSaisie_Click()" & vbCrLf
    Code = Code & "UserForm7_Saisie.Show" & vbCrLf
    Code = Code & "ActiveSheet.OLEObjects(2).Visible = True" & vbCrLf
    Code = Code & "End Sub"

    With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
        NextLine = .CountOfLines + 1
        .insertlines NextLine, Code
    End With
    
    Set oOLE = ActiveWorkbook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, Left:=310, Top:=4, Width:=85, Height:=25)

    oOLE.Name = "CmdTermine"
    ActiveSheet.OLEObjects(2).Object.FontBold = True
    ActiveSheet.OLEObjects(2).Object.Caption = "Terminé"
    Code = "Sub CmdTermine_Click()" & vbCrLf
    Code = Code & "MsgBox ""Terminé""" & vbCrLf
    Code = Code & "End Sub"

    With ActiveWorkbook.VBProject.vbcomponents(ActiveSheet.CodeName).codemodule
        NextLine = .CountOfLines + 1
        .insertlines NextLine, Code
    End With
    
    
End If
 
Dernière édition:

StrikeBEH

XLDnaute Occasionnel
Re : Créer un CommandButton dynamique

Bonsoir Lone-wolf,

Si la feuille pour le mois en cours existe alors MenCours = 1

Si MenCours=0 alors création de la feuille pour le mois en cours...
' Création Feuille Récap & Feuille pour mois en cours
For i = 1 To Sheets.Count
Application.ActiveWindow.DisplayGridlines = False ' Désactive le cadrillage
If Sheets(i).Name = (vMenCours) Then
MenCours = 1
Exit For
End If
Next i

If MenCours = 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = (vMenCours)
ActiveWorkbook.Sheets(vMenCours).Tab.Color = vbCyan
ActiveWindow.DisplayGridlines = False ' Désactive le cadrillage

Pour la deuxième question, maintenant j'ai deux bontons sur ma feuille: un pour "Nouvelle saisie" et l'autre pour "Terminé".

Ca répond à vos questions ?
 
Dernière édition:

Discussions similaires

Réponses
8
Affichages
664

Statistiques des forums

Discussions
312 231
Messages
2 086 442
Membres
103 210
dernier inscrit
Bay onais