AW: Benutzerdefiniertes Menü für ein Workbook
07.12.2006 10:33:19
mumpel
Hallo!
Hier mal ein Beispielcode. Diesen Code in "DieseArbeitsmappe" Deiner Arbeitsmappe, bei welcher das Menü erscheinen soll:
Private Sub Workbook_Open()
On Error resume Next
Dim i As Integer
Dim i_Hilfe As Integer
Dim MenüNeu As CommandBarPopup
Dim MB As CommandBarControl
Dim MC As CommandBarPopup
Dim MA As CommandBarControl
Set myBar = CommandBars(1)
Set ctrl1 = myBar.Controls("?")
'i = Application.CommandBars(1).Controls.Count
'i_Hilfe = Application.CommandBars(1).Controls(i).Index
'Set MenüNeu = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, _
'Before:=ctrl1.Index, Temporary:=True)
'MenüNeu.Caption = "Arbeits&Zeit"
Set MenüNeu = Application.CommandBars(1).Controls.Add(Before:=ctrl1.Index, Type:=msoControlPopup) 'Menütitel
With MenüNeu
.Caption = "Arbeits&Zeit"
' .TooltipText = "Hier blenden Sie die Menüleisten der A-Soft AddIns ein und aus"
.BeginGroup = False
End With
On Error Resume Next
Set MC = MenüNeu.Controls.Add(Type:=msoControlPopup)
With MC
.Caption = "&Monats-Auswahl"
.BeginGroup = True
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "&Januar"
.Style = msoButtonCaption
.OnAction = "JanEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "&Februar"
.Style = msoButtonCaption
.OnAction = "FebEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "M&ärz"
.Style = msoButtonCaption
.OnAction = "MarzEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "A&pril"
.Style = msoButtonCaption
.OnAction = "AprilEin"
.BeginGroup = True
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "Ma&i"
.Style = msoButtonCaption
.OnAction = "MaiEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "Ju&ni"
.Style = msoButtonCaption
.OnAction = "JuniEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "Ju&li"
.Style = msoButtonCaption
.OnAction = "JuliEin"
.BeginGroup = True
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "Au&gust"
.Style = msoButtonCaption
.OnAction = "AugEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "&September"
.Style = msoButtonCaption
.OnAction = "SeptEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "O&ktober"
.Style = msoButtonCaption
.OnAction = "OktoberEin"
.BeginGroup = True
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "No&vember"
.Style = msoButtonCaption
.OnAction = "NovEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "&Dezember"
.Style = msoButtonCaption
.OnAction = "DezEin"
End With
Set MB = MC.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "Alle Mona&te"
.Style = msoButtonCaption
.OnAction = "AlleMonateEin"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Antr&äge aufrufen"
.Style = msoButtonIconAndCaption
.FaceId = 42
.OnAction = "Aufruf_show"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Persönliche Daten eingeben"
.Style = msoButtonIconAndCaption
.FaceId = 1665
.OnAction = "PersönlicheDaten"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Arbeitszeiten &verwalten"
.Style = msoButtonIconAndCaption
.FaceId = 125
.OnAction = "Arbeitszeiten"
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Zuschl&äge berechnen"
.Style = msoButtonIconAndCaption
.FaceId = 395
.OnAction = "Kosten"
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Ar&beitszeiten säubern"
.Style = msoButtonIconAndCaption
.FaceId = 47
.OnAction = "Säubern1"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Nebenbezüge säubern"
.Style = msoButtonIconAndCaption
.FaceId = 110
.OnAction = "Säubern2"
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Zeilen- und Spaltenköpfe ein- ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 966
.OnAction = "DisplayHeadings"
.BeginGroup = True
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Registerlaschen ein- ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 461
.OnAction = "TabsOn"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&ScrollLeisten ein- ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 237
.OnAction = "ScrollBars"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Gitternetzlinien ein- bzw. ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 485
.OnAction = "Gridlines"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Spalten ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 2166
.OnAction = "Spalten_Aus"
.BeginGroup = True
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "S&palten einblenden"
.Style = msoButtonIconAndCaption
.FaceId = 2162
.OnAction = "Spalten_Ein"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Zeilen ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 2164
.OnAction = "Zeilen_Aus"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Zei&len einblenden"
.Style = msoButtonIconAndCaption
.FaceId = 2161
.OnAction = "Zeilen_Ein"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Zellen entspe&rren"
.Style = msoButtonIconAndCaption
.FaceId = 162
.OnAction = "ZellenEntsperrenUndEinblenden"
.Enabled = False
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Z&ellen sperren"
.Style = msoButtonIconAndCaption
.FaceId = 519
.OnAction = "ZellenSperrenUndAusblenden"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "N&icht leere Felder sperren"
.Style = msoButtonIconAndCaption
.FaceId = 572
.OnAction = "nicht_leere_Felder_schützen"""
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Tabellenblatt sch&ützen bzw entschützen"
.Style = msoButtonIconAndCaption
.FaceId = 519
.OnAction = "Blattsperre"
.Enabled = False
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Bearbeitungs&leiste ein- ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 598
.OnAction = "BleisteEin"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "S&crollarea aufheben"
.Style = msoButtonIconAndCaption
.FaceId = 447
.OnAction = "ScrollAreaAufheben"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Arbei&tsmappenschutz aufheben"
.Style = msoButtonIconAndCaption
.FaceId = 470
.OnAction = "MappeFrei"
.Enabled = False
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Arbeitsmappe speichern"
.Style = msoButtonIconAndCaption
.FaceId = 271
.OnAction = "SpeichernUnter"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Hilf&edokument aufrufen"
.Style = msoButtonIconAndCaption
.FaceId = 345
.OnAction = "HilfeAufrufen"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "S&ymbolleiste Arbeitszeit ein- ausblenden"
.Style = msoButtonIconAndCaption
.FaceId = 1019
.OnAction = "SymbLeisteOnOff"
.BeginGroup = True
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "&Diese Arbeitsmappe aus- einblenden"
.Style = msoButtonIconAndCaption
.FaceId = 480
.OnAction = "AZTab34_MRTHilfe"
End With
Set MA = MenüNeu.Controls.Add(Type:=msoControlButton)
With MA
.Caption = "Arbeitsmappe freisc&halten"
.Style = msoButtonIconAndCaption
.FaceId = 277
.OnAction = "register_show"
.BeginGroup = True
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
With Application.CommandBars(1)
.Controls("ArbeitsZeit").Delete
End With
Application.CommandBars("Arbeitszeit").Delete
End Sub
Gruss Rene