Private Sub Workbook_Open()
    Dim CmdB As CommandBar, nCmdB As CommandBar
    Dim nCtlP As CommandBarPopup, nCtlB As CommandBarButton
    For Each CmdB In Application.CommandBars
     If CmdB.Type = msoBarTypeMenuBar And _
        CmdB.Name = "Meine Menueleiste" Then
        CmdB.Delete
    End If
   Next CmdB
    Set nCmdB = Application.CommandBars.Add _
        (Name:="Meine Menueleiste", Position:=msoBarTop, _
        MenuBar:=True, Temporary:=True)
   With nCmdB
        .Protection = msoBarNoMove
        .Protection = msoBarNoChangeDock
        .Protection = msoBarNoChangeVisible
        .Protection = msoBarNoCustomize
        .Protection = msoBarNoVerticalDock
        .Visible = True
    End With
    Set nCtlP = nCmdB.Controls.Add(Type:=msoControlPopup)
   With nCtlP
        .Caption = "Mein Menue &1"
    End With
    Set nCtlB = nCtlP.Controls.Add(Id:=247)
   With nCtlB
        .Style = msoButtonCaption
    End With
    Set nCtlB = nCtlP.Controls.Add(Id:=109)
   With nCtlB
        .Style = msoButtonAutomatic
    End With
    Set nCtlB = nCtlP.Controls.Add(Id:=4)
   With nCtlB
        .BeginGroup = True
        .Style = msoButtonAutomatic
    End With
    Set nCtlP = nCmdB.Controls.Add(Type:=msoControlPopup)
   With nCtlP
        .Caption = "Mein Menue &2"
    End With
    Set nCtlB = nCtlP.Controls.Add(Id:=1)
   With nCtlB
        .Caption = "Mein VBA-Makro &1"
        .OnAction = "Me_001_Code01"
        .Style = msoButtonCaption
    End With
    Set nCtlB = nCtlP.Controls.Add(Id:=1)
   With nCtlB
        .BeginGroup = True
        .FaceId = 239
        .Caption = "Mein VBA-Makro &2"
        .OnAction = "Me_001_Code02"
        .Style = msoButtonIconAndCaption
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call Me_001_Delete
End Sub

Public Sub Me_001_Code01()
       MsgBox "Die Option 'Mein VBA-Makro 1' wurde gewählt!", _
              vbInformation, "Code-Beispiel (Me_001)"
End Sub

Public Sub Me_001_Code02()
       MsgBox "Die Option 'Mein VBA-Makro 2' wurde gewählt!", _
              vbInformation, "Code-Beispiel (Me_001)"
End Sub

Public Sub Me_001_Delete()
    On Error Resume Next
       Application.CommandBars("Meine Menueleiste").Delete
    On Error GoTo 0
End Sub

Download

Private Sub Workbook_Open()
    Dim CmdB As CommandBar, nCmdB As CommandBar
    Dim nCtlB As CommandBarButton
    For Each CmdB In Application.CommandBars
     If CmdB.Type = msoBarTypePopup And _
        CmdB.Name = "Mein Kontextmenue" Then
        CmdB.Delete
    End If
   Next CmdB
    Set nCmdB = Application.CommandBars.Add _
        (Name:="Mein Kontextmenue", Position:=msoBarPopup, _
        Temporary:=True)
    Set nCtlB = nCmdB.Controls.Add(Id:=1)
   With nCtlB
        .Caption = "Mein VBA-Makro &1"
        .OnAction = "Me_002_Code"
        .Style = msoButtonCaption
    End With
    Set nCtlB = nCmdB.Controls.Add(Id:=1)
   With nCtlB
        .FaceId = 239
        .Caption = "Mein VBA-Makro &2"
        .OnAction = "Me_002_Code"
        .Style = msoButtonIconAndCaption
    End With
    Set nCtlB = nCmdB.Controls.Add(Id:=247)
   With nCtlB
        .BeginGroup = True
        .Style = msoButtonCaption
    End With
    Set nCtlB = nCmdB.Controls.Add(Id:=109)
   With nCtlB
        .Style = msoButtonAutomatic
    End With
    Set nCtlB = nCmdB.Controls.Add(Id:=4)
   With nCtlB
        .BeginGroup = True
        .Style = msoButtonAutomatic
    End With
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, _
        ByVal Target As Excel.Range, Cancel As Boolean)
        Cancel = True
     On Error GoTo Fehler
        Application.CommandBars("Mein Kontextmenue").ShowPopup
   Exit Sub
Fehler:
Cancel = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call Me_002_Delete
End Sub

Public Sub Me_002_Code()
       MsgBox "Die Option 'Mein VBA-Makro " & _
              Application.CommandBars("Mein Kontextmenue") _
              .Controls(Application.Caller(1)).Index & _
              "' wurde gewählt!", _
              vbInformation, "Code-Beispiel (Me_002)"
End Sub

Public Sub Me_002_Delete()
    On Error Resume Next
       Application.CommandBars("Mein Kontextmenue").Delete
    On Error GoTo 0
End Sub

Download

Private VisibleCmdBs As New Collection

Private Sub Workbook_Open()
    Dim CmdB As CommandBar
    For Each CmdB In Application.CommandBars
     If CmdB.Type = msoBarTypeNormal And CmdB.Visible = True Then
        VisibleCmdBs.Add CmdB, CmdB.Name
        CmdB.Visible = False
    End If
   Next CmdB
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim CmdB As Object
    For Each CmdB In VisibleCmdBs
        CmdB.Visible = True
   Next CmdB
    Set VisibleCmdBs = Nothing
End Sub

Download

Private VisibleCmdBs As New Collection

Public Sub Me_004_Invisible()
   Dim CmdB As CommandBar
   For Each CmdB In Application.CommandBars
    If CmdB.Type = msoBarTypeNormal And CmdB.Visible = True Then
       VisibleCmdBs.Add CmdB, CmdB.Name
       CmdB.Visible = False
   End If
  Next CmdB
End Sub

Public Sub Me_004_Visible()
   Dim CmdB As Object
   For Each CmdB In VisibleCmdBs
       CmdB.Visible = True
  Next CmdB
   Set VisibleCmdBs = Nothing
End Sub

Download

Public Sub Me_005()
   Dim CmdB As CommandBar
   Dim CmdBName As String 'Dim CmdBName$
       CmdBName = "Shadow Settings"
   For Each CmdB In Application.CommandBars
    If CmdB.Type = msoBarTypeNormal And CmdB.Name = CmdBName Then
       MsgBox "Die Symbolleiste '" & CmdBName & "' existiert!", _
              vbInformation, "Code-Beispiel (Me_005)"
  Exit Sub
   End If
  Next CmdB
       MsgBox "Die Symbolleiste '" & CmdBName & "' existiert" & _
              " nicht!", _
              vbInformation, "Code-Beispiel (Me_005)"
End Sub

Download

Public Sub Me_006()
   Dim CmdB As CommandBar
   Dim i As Integer 'Dim i%
       i = 1
  With ActiveSheet
       .[A:B].ClearContents
       .[A1].Value = "Name"
       .[B1].Value = "Lokaler Name"
   End With
   For Each CmdB In Application.CommandBars
    If CmdB.Type = msoBarTypeNormal Then
       i = i + 1
  With ActiveSheet
       .Cells(i, 1).Value = CmdB.Name
       .Cells(i, 2).Value = CmdB.NameLocal
   End With
   End If
  Next CmdB
       ActiveSheet.Columns("A:B").AutoFit
End Sub

Download

Private Sub Workbook_Open()
    Dim CmdB As CommandBar
    Dim Ctl As CommandBarControl, nCtlC As CommandBarComboBox
    For Each Ctl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls
     If Ctl.Type = msoControlComboBox And _
        Ctl.Caption = "Symbolleistenauswahl" Then
        Ctl.Delete
    End If
   Next Ctl
   With Application.CommandBars("Worksheet Menu Bar")
    Set nCtlC = .Controls.Add(Type:=msoControlComboBox, _
        Before:=.Controls.Count, Temporary:=True)
    End With
   With nCtlC
        .Caption = "Symbolleistenauswahl"
        .OnAction = "Me_007_Visible"
    For Each CmdB In Application.CommandBars
     If CmdB.Type = msoBarTypeNormal Then
        .AddItem CmdB.NameLocal
    End If
   Next CmdB
        .DropDownLines = 20
        .Width = 150
        .ListIndex = 1
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call Me_007_Delete
End Sub

Public Sub Me_007_Visible()
   Dim CmdB As CommandBar
   Dim CtlC As CommandBarComboBox
   Dim CmdBName As String 'Dim CmdBName$
   Set CtlC = Application.CommandBars("Worksheet Menu Bar") _
       .Controls("Symbolleistenauswahl")
       CmdBName = CtlC.List(CtlC.ListIndex)
   For Each CmdB In Application.CommandBars
    If CmdB.Type = msoBarTypeNormal And _
       CmdB.NameLocal = CmdBName Then
       CmdB.Visible = True
  Exit Sub
   End If
  Next CmdB
       MsgBox "Die Symbolleiste '" & CmdBName & "' existiert" & _
              " nicht!", _
              vbInformation, "Code-Beispiel (Me_007)"
End Sub

Public Sub Me_007_Delete()
    On Error Resume Next
       Application.CommandBars("Worksheet Menu Bar") _
       .Controls("Symbolleistenauswahl").Delete
    On Error GoTo 0
End Sub

Download