AW: @ Josef Ehrensberger
02.09.2006 19:25:47
Peter
Hallo Sepp
hier der Code
Kannst du den so umbauen das beide Menus dann funktionieren.?
Allerdings habe ich 2 unterschiedliche Dateien. (1 mal mit und ohne Untermenu)
Diese hier ist ohne Untermenu:
DieseArbeitsmappe:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
HideSheets True
Me.Save
deleteMenue
End Sub
Private Sub Workbook_Activate()
makeMenue
End Sub
Private Sub Workbook_Deactivate()
deleteMenue
End Sub
Unter Makro:
Option Explicit
Private Const menueName As String = "Spezialmenu"
Private Const strPW As String = "mein Passwort" ' dein Passwort - anpassen!
Sub makeMenue()
Dim cbMenu As CommandBar
Dim cbSpecialMenu As CommandBarPopup
Dim cbCommand As CommandBarButton
deleteMenue
'Zuweisen der Objectvariablen
Set cbMenu = Application.CommandBars("Worksheet Menu Bar")
Set cbSpecialMenu = cbMenu.Controls.Add(Type:=msoControlPopup)
'Titelbeschriftung der Menübar
cbSpecialMenu.Caption = menueName
'Einen Button hinzufügen und diesen gleich beschriften
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Menü aktivieren"
.OnAction = "activateMenu"
.FaceId = 343
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Einen Drucker auswählen"
.OnAction = ""
.FaceId = 1
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Aktiver Drucker"
.OnAction = "Makro15"
.FaceId = 4
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Drucken auf LPQ3"
.OnAction = "Makro14"
.FaceId = 4
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = ""
.OnAction = ""
.FaceId = 1
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Monate in den Diagrammen ändern"
.OnAction = ""
.FaceId = 1
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Januar"
.OnAction = "Makro1"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Februar"
.OnAction = "Makro2"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "März"
.OnAction = "Makro3"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "April"
.OnAction = "Makro4"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Mai"
.OnAction = "Makro5"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Juni"
.OnAction = "Makro6"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Juli"
.OnAction = "Makro7"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "August"
.OnAction = "Makro8"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "September"
.OnAction = "Makro9"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Oktober"
.OnAction = "Makro10"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "November"
.OnAction = "Makro11"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Dezember"
.OnAction = "Makro12"
.FaceId = 16
.Enabled = False
End With
Set cbMenu = Nothing
Set cbCommand = Nothing
Set cbSpecialMenu = Nothing
End Sub
Sub deleteMenue()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(menueName).Delete
On Error GoTo 0
End Sub
Private Sub activateMenu()
Dim objCntrl As CommandBarControl
If InputBox(" Passwort:", "Hier das Passwort zum Freischalten eingeben:") = strPW Then
For Each objCntrl In Application.CommandBars.ActionControl.Parent.Controls
objCntrl.Enabled = True
Next
With Application.CommandBars.ActionControl
.FaceId = 343
.Enabled = False
End With
Else
MsgBox "Falsches Passwort!", 64, "Fehler"
End If
End Sub
Gruß Peter