Une macro qui crée un bouton qui execute une macro

[neo]

bonjour,

je cree une macro qui ouvre une nouvelle feuille...

seulement, dans cette feuille, je souhaite qu'il y ait un boutton, qui va lancer une autre macro.
j'ai donc deux soucis:
-comment creer mon bouton dans ma feuille (à l'aide de ma macro)
-comment, une fois le bouton crée, lui affecter une macro à executer...

merci

neo

 

[Kadra]

Tu peux utiliser les classes, va sur excelabo.net et cherche getoption tu trouvera tout une serie de lien de personnes travaillant sur le sujet walkenback etc etc

 

[Zon]

Re:Une macro qui crée un bouton qui execute une ma

Salut,

On est pas obligé de passer par les classes, voici un exemple

  Sub Princ()
  Dim Ch$
    If SupprBouton(Sheets(1), 'Bt1') = 0 Then
      SuprrUneProc ThisWorkbook, Sheets(1).CodeName, 'Bt1_Click'
    End If
    Ch = 'MsgBox ''Salut XLD'''  'le code à mettre dans la procédure qu'éxécutera le bouton
    AjouterUnBouton Sheets(1), 'Bt1', Array(30, 4, 100, 20, 'Mon Bouton') 'ici dans la feuille 1 le bouton s'appelle mon bouton
    AjouterProcEven ThisWorkbook, Sheets(1).CodeName, 'Click', 'Bt1', Ch
  End Sub
 
  Sub AjouterUnBouton(F As Worksheet, Optional Nom$, Optional T)
    Dim B As OLEObject
    Set B = F.OLEObjects.Add('Forms.commandbutton.1')
   
With B
      .Name = Nom
      .Left = T(0)
      .Top = T(1)
      .Width = T(2)
      .Height = T(3)
      .Object.Caption = T(4)
    End With
  End Sub
 
  Sub AjouterProcEven(C As Workbook, NomModule$, Evenement$, Objet$, Code$)
    With C.VBProject.VBComponents(NomModule).CodeModule
      .InsertLines .CreateEventProc(Evenement, Objet) + 1, Code
    End With
  End Sub
 
  Function SupprBouton&(F As Worksheet, Nom$)
    On Error Resume Next
    F.OLEObjects(Nom).Delete
    SupprBouton = Err
  End Function
 
  Sub SuprrUneProc(C As Workbook, NomModule$, NomProc$)
    With C.VBProject.VBComponents(NomModule).CodeModule
      .DeleteLines .ProcStartLine(NomProc, 0), .ProcCountLines(NomProc, 0)
    End With
  End Sub

A+++

 

[mutzik]

Re:Une macro qui crée un bouton qui execute une ma

Bonjour le fil, le forum

Et pourquoi tu mettrais pas un bouton dans la barre de menus qui te lancerait cette macro, cela ne serait-il pas beaucoup plus simple ?

 

[_Thierry]

Re:Une macro qui crée un bouton qui execute une ma

Bonjour Zon, Néo, Mutzik, Kadra, le Forum

Je ne sais pas si ce serait plus simple Mutzik, mais je pense que le besoin de Neo est de faire circuler une feuille de son classeur crée à la Volée avec son Bouton et son Code Autonome...

Enfin je comprends comme ça car en tout cas je sais que j'ai souvent eu recours à des codes pour mes démos dans le Forum XLD 1st Génération si vous vous souvenez de ce CommandButton :



Et vu le nombre de fois où ce bouton était à dessiner sur la feuille 'Home' de toutes ces Démos j'avais écrit ceci... Depuis je suis passé en Shape au détriment des OLEObject CommandButton dans un souci de Compatibilité Mac.

Option Explicit

Const GTU As String = 'Go To UserForm !!!'
Const USF As String = 'UserForm1'

Sub CreateOLEButton()
Dim CmdButton As OLEObject
Dim Cell As Range
Dim L As Double, T As Double, W As Double, H As Double
Dim x As Byte

    With ActiveSheet
        Set Cell = .Range('A1')
       
            L = Cell.Left
            T = Cell.Top
            W = 140
            H = 25
         
        Set CmdButton = .OLEObjects.Add(ClassType:='Forms.commandbutton.1', _
                            Left:=L, Top:=T, Width:=W, Height:=H)
    End With
   
    With CmdButton
    .Name = 'CommandButton1'
        With .Object
        .BackColor = 0
        .ForeColor = 65535
            With .Font
            .Size = 11
            .Italic = True
            .Bold = True
            End With
        .Caption = GTU
        End With
    End With


With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    x = .CountOfLines
    .InsertLines x + 1, ''@+Thierry's Démo sur www.excel-downloads, ' & Format(Date, 'mmm yyyy')
    .InsertLines x + 2, 'Sub CommandButton1_Click()'
    .InsertLines x + 3, USF & '.Show'
    .InsertLines x + 4, 'End Sub'
End With


End Sub

C'est un code cousin de celui Proposé par Zon mais il sera probablement plus facilement interprétable pour des débutants.

Pour Kadra, que je n'ai pas l'honneur de connaître, nous avons de très bonnes relations avec Misange, mais cependant il est de règle en général d'essayer de trouver dans les ressources internes du Forum XLD (qui sont autre que Vastes) avant d'aiguiller les gens vers des liens externes.

Que ma démarche soit bien interprétée, il n'y a absolument pas de concurrence, c'est juste pour le respect de David notre WebMaster et de tous les Contributeurs et Contributrices qui se donnent à fond ici depuis des années.

Bonne Fin de Journée
[ol]@+Thierry[/ol]

Message édité par: _Thierry, à: 29/08/2005 17:40