AW: Menü - Submenü
06.10.2003 13:07:22
Marcel
Moin, hier ein Beispiel, welches ich gebastelt habe. Was hinter OnAction= steht, sind Makros, die ich hinterher aufgenommen habe.
Sub CreateMenu()
Dim CB As CommandBar
Dim CBP As CommandBarPopup
Dim CBP1 As CommandBarPopup
Dim CBP2 As CommandBarPopup
Dim CBP3 As CommandBarPopup
Dim CBP4 As CommandBarPopup
Dim CBB1 As CommandBarButton
Dim CBB2 As CommandBarButton
Dim CBB3 As CommandBarButton
Dim CBB4 As CommandBarButton
Dim CBB5 As CommandBarButton
Dim CBB6 As CommandBarButton
Dim CBB7 As CommandBarButton
Dim CBB8 As CommandBarButton
Dim CBB9 As CommandBarButton
Dim CBB10 As CommandBarButton
Dim CBB11 As CommandBarButton
Dim CBB12 As CommandBarButton
Dim CBB13 As CommandBarButton
Dim CBB14 As CommandBarButton
Dim CBB15 As CommandBarButton
Set CB = Nothing
On Error Resume Next
Application.CommandBars("VS").Delete
On Error GoTo ErrorHandle
Set CB = Application.CommandBars.Add(Name:="VS", Position:=msoBarTop)
Set CBP = CB.Controls.Add(Type:=msoControlPopup, temporary:=False)
With CBP
.Caption = "Versuch"
End With
Set CBP1 = CBP.Controls.Add(Type:=msoControlPopup, temporary:=False)
With CBP1
.Caption = "Neue Mappen anlegen"
End With
Set CBP2 = CBP.Controls.Add(Type:=msoControlPopup, temporary:=False)
With CBP2
.Caption = "Kopieren in Ablage"
End With
Set CBP3 = CBP.Controls.Add(Type:=msoControlPopup, temporary:=False)
With CBP3
.Caption = "Mailversand"
End With
Set CBP4 = CBP.Controls.Add(Type:=msoControlPopup, temporary:=False)
With CBP4
.Caption = "Teamdaten"
End With
Set CBB3 = CBP1.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB3
.Caption = "Datei mit 12 Monatsblättern anlegen"
.OnAction = "Monatsmappe_in_C"
End With
Set CBB1 = CBP1.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB1
.Caption = "BB-Datei mit 12 Monatsblättern anlegen"
.OnAction = "MonatsmappeBB_in_C"
End With
Set CBB2 = CBP3.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB2
.Caption = "Mailversand AMA"
.OnAction = "Mail_AMA"
End With
Set CBB4 = CBP3.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB4
.Caption = "Mailversand BB"
.OnAction = "Mail_BB"
End With
Set CBB6 = CBP3.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB6
.Caption = "Mailversand FbW"
.OnAction = "Mail_FbW"
End With
Set CBB5 = CBP3.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB5
.Caption = "Mailversand Zsp"
.OnAction = "Mail_Zsp"
End With
Set CBB7 = CBP.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB7
.Caption = "Meldezettel"
.OnAction = "open4"
End With
Set CBB8 = CBP2.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB8
.Caption = "AMA kopieren"
.OnAction = "Ablage_AMA"
End With
Set CBB9 = CBP2.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB9
.Caption = "BB kopieren"
.OnAction = "Ablage_BB"
End With
Set CBB10 = CBP2.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB10
.Caption = "FbW kopieren"
.OnAction = "Ablage_FbW"
End With
CB.Visible = True
Set CBB11 = CBP2.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB11
.Caption = "Zsp kopieren"
.OnAction = "Ablage_Zsp"
End With
Set CBB12 = CBP4.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB12
.Caption = "Teamdaten für Tabellen I00 - I08"
.OnAction = "IC.Modul10.Teamdaten"
End With
Set CBB13 = CBP.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB13
.Caption = "Zeitreihe SteA-WZ erstellen"
.OnAction = "SteA_WZ"
End With
Set CBB14 = CBP.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB14
.Caption = "BB-Tab 5 und 5a erstellen"
.OnAction = "BB_Tab5"
End With
Set CBB15 = CBP4.Controls.Add(Type:=msoControlButton, temporary:=False)
With CBB15
.Caption = "Teamdaten für Alg LE"
.OnAction = "IC.Modul11.TeamDaten"
End With
CB.Visible = True
Exit Sub
ErrorHandle:
MsgBox Title:="Es ist ein Fehler aufgetreten", _
Prompt:="Fehlernummer: " & Err.Number & vbCrLf & _
"Fehlerbeschreibung: " & Err.Description, _
Buttons:=vbCritical
End Sub