Selbstdefinierte Excel-Menüs

Menüs programmieren

mit Gruppierung, Untermenüs und Titelleiste

Eine Interesannte Möglichkeit ist es, eigene Menüs mit der Mappe zu öffnen, die dann nur in diesem Workbook zu sehen sind, und mit dem Schliessen oder dem Wechseln des Fensters des Workbooks wieder verschwinden.
Ausserdem, wenn man die Titelleiste einer Arbeitsmappe verändern möchte, ist der zusätzliche Code dafür einfach im gleichen Makro unterzubringen.
Unbedingt zu beachten:
Der Code ist im VBA-Editor im Codefenster von "Diese Arbeitsmappe" einzugeben. Einfach komplett kopieren und per "Drag and Drop" dort einfügen.
Die folgenden Makros dürften weitestgehend selbsterklärend sein.
Achte in diesem Beispiel auf "BeginGroup" und die Modifikation der Titelleiste mit "Application.Caption" und "ActiveWindow.Caption"
wobei mit "Name" der Name des betreffenden Workbooks gemeint ist. Diese Codezeile kann komplett weggelassen werden, wenn hier immer der Name des gerade aktiven Workbook's stehen soll. Darum habe ich in diesem Beispiel auch die Zeilen auskommentiert.

Private Sub Workbook_Open()

Dim cbSpecialMenu As CommandBarPopup
Dim UMenu As CommandBarPopup
Dim cbCommand As CommandBarControl
Dim UcbCommand As CommandBarControl

Set cbSpecialMenu = _
Application.CommandBars("Worksheet Menu Bar") _
.Controls.Add(Type:=msoControlPopup)
cbSpecialMenu.Caption = "S&pezialmenue"

Set cbCommand = _
cbSpecialMenu.Controls.Add(Type:=msoControlButton)
cbCommand.Caption = "&Zeilen kopieren"
cbCommand.OnAction = "Monatszeilen_kopieren"

Set UMenu = _
cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
UMenu.Caption = "&Monate"
UMenu.BeginGroup = True

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Januar"
UcbCommand.OnAction = "Januar"
cbCommand.BeginGroup = True

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Februar"
UcbCommand.OnAction = "Februar"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&März"
UcbCommand.OnAction = "März"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&April"
UcbCommand.OnAction = "April"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "Ma&i"
UcbCommand.OnAction = "Mai"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "J&uni"
UcbCommand.OnAction = "Juni"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "Ju&li"
UcbCommand.OnAction = "Juli"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "Au&gust"
UcbCommand.OnAction = "August"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&September"
UcbCommand.OnAction = "September"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Oktober"
UcbCommand.OnAction = "Oktober"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&November"
UcbCommand.OnAction = "November"

Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Dezember"
UcbCommand.OnAction = "Dezember"

Application.Caption = "Excel-Tuning by HS"
' ActiveWindow.Caption = ActiveWorkbook.Name
' oder: ActiveWindow.Caption = "eigener Text"

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim cbSpecialMenu As CommandBarControl

On Error Resume Next
Set cbSpecialMenu = _
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Spezialmenue")
cbSpecialMenu.Delete

Application.Caption = ""
' ActiveWindow..Caption = ActiveWorkbook.Name

End Sub

Private Sub Workbook_Deactivate()

On Error Resume Next
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Spezialmenue").Visible = False

Application.Caption = ""
' ActiveWindow.Caption = ActiveWorkbook.Name

End Sub

Private Sub Workbook_Activate()

On Error Resume Next
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Spezialmenue").Visible = True

Application.Caption = "Excel-Tuning by HS"
' ActiveWindow.Caption = ActiveWorkbook.Name
' oder: ActiveWindow.Caption = "eigener Text"

End Sub