Thema: Blattschaltflächen in Menüschaltflächen konvertieren.

StandardModule: Modul1

Sub MeldungA()
   MsgBox "Aufruf durch erste Schaltfläche"
End Sub

Sub MeldungB()
   MsgBox "Aufruf durch zweite Schaltfläche"
End Sub

Sub ConvertToCommandButton()
   Dim cnt As CommandBarControl
   Dim btn As CommandBarButton
   Dim wksBtn As Button
   Set cnt = Application.CommandBars.FindControl(ID:=30007)
   Set btn = cnt.Controls.Add
   With btn
      .Caption = ActiveSheet.Buttons("Btn1").Caption
      .OnAction = ActiveSheet.Buttons("Btn1").OnAction
      .Style = msoButtonCaption
   End With
   Set btn = cnt.Controls.Add
   With btn
      .Caption = ActiveSheet.Buttons("Btn2").Caption
      .OnAction = ActiveSheet.Buttons("Btn2").OnAction
      .Style = msoButtonCaption
   End With
   Set wksBtn = ActiveSheet.Buttons.Add( _
      Left:=Range("B11").Left, _
      Top:=Range("B11").Top, _
      Width:=Range("C12").Left + Range("C12").Width - Range("B12").Left, _
      Height:=Range("B12:B13").Height)
   With wksBtn
      .Caption = "Buttons zum Blatt"
      .OnAction = "ConvertToButton"
      .Name = "Btn4"
   End With
   ActiveSheet.Buttons("Btn1").Delete
   ActiveSheet.Buttons("Btn2").Delete
   ActiveSheet.Buttons("Btn3").Delete
End Sub

Sub ConvertToButton()
   Dim cnt As CommandBarControl
   Dim btn As CommandBarButton
   Dim wksBtn As Button
   Set cnt = Application.CommandBars.FindControl(ID:=30007)
   Set btn = cnt.Controls("Meldung A")
   Set wksBtn = ActiveSheet.Buttons.Add( _
      Left:=Range("B3").Left, _
      Top:=Range("B3").Top, _
      Width:=Range("C3").Left + Range("C3").Width - Range("B3").Left, _
      Height:=Range("B3:B4").Height)
   With wksBtn
      .Caption = btn.Caption
      .OnAction = btn.OnAction
      .Name = "Btn1"
   End With
   Set btn = cnt.Controls("Meldung B")
   Set wksBtn = ActiveSheet.Buttons.Add( _
      Left:=Range("B6").Left, _
      Top:=Range("B6").Top, _
      Width:=Range("C6").Left + Range("C6").Width - Range("B6").Left, _
      Height:=Range("B6:B7").Height)
   With wksBtn
      .Caption = btn.Caption
      .OnAction = btn.OnAction
      .Name = "Btn2"
   End With
   Set wksBtn = ActiveSheet.Buttons.Add( _
      Left:=Range("B9").Left, _
      Top:=Range("B9").Top, _
      Width:=Range("C9").Left + Range("C9").Width - Range("B9").Left, _
      Height:=Range("B9:B10").Height)
   With wksBtn
      .Caption = "Buttons zum Extra-Menü"
      .OnAction = "ConvertToCommandButton"
      .Name = "Btn3"
   End With
   cnt.Controls("Meldung A").Delete
   cnt.Controls("Meldung B").Delete
   ActiveSheet.Buttons("Btn4").Delete
End Sub

Beiträge aus dem Excel-Forum zu den Themen Menue und Button