Wenn ich durch Programmcode - wie unten aufgeführt - Menü- bzw. Symbolleisten in mein Project einbringen möchte, ist es richtig, den Quelltext hierzu in ein Modul einzubringen, oder sollte man ihn in "Diese Arbeitsmappe" einfügen ?
Mein Problem ist, daß ich beim Versuch den u.g. Quelltext in Excel 2000 auszuführen einen Laufzeitfehler 5 erhalte, bei dem wenn ich im Meldungsfenster "Debuggen" anklicke, der von mir mit "FEHLERANWEISUNG" gekennzeichnete Anweisungsbeeich gelb unterlegt ist. Was mache ich falsch ?
Was habe ich vergessen zu bedenken ?
Kopeiert das Ganze doch einfach mal in ein eigenes Modul und probiert.
Vielen Dank für Eure Hilfe
Const MenuName = "Demo-Menü"
Const OpenIcon = 23
Const SaveIcon = 3
Const MugIcon = 480
Sub DemoMenuSystem()
'Erzeugt und installiert ein Demonstrations-Menüsystem
Dim myMenuBar As CommandBar
Dim aMenu As Object
'Benutzerdefinierte Befehlsleiste erzeugen
FEHLERANWEISUNG: Set myMenuBar = CommandBars.Add
(Name:="Demo-Menü", _
MenuBar:=True, _
temporary:=True)
'Menüeinträge der obersten Ebene in Menüleiste eintragen
With myMenuBar.Controls
'Menü Datei hinzufügen
Set aMenu = .Add(Type:=msoControlPopup, temporary:=True)
aMenu.Caption = "&Datei"
'Demo-Menü hinzufügen
aMenu.Caption = "De&mo"
End With
'Menü Datei füllen.
With myMenuBar.Controls("Datei").Controls
'Menüeintrag Datei|
ffnen hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "
&ffnen"
aMenu.FaceId = OpenIcon
aMenu.OnAction = "DummyCommand"
aMenu.Parameter = "Datei öffnen"
'Menüeintrag Datei|Speichern hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "&Speichern"
aMenu.FaceId = SaveIcon
aMenu.OnAction = "DummyCommand"
aMenu.Parameter = "Datei speichern"
'Menüeintrag Datei|Beenden hinzufügen, neue Gruppe beginnen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption "&Beenden"
aMenu.OnAction = "ExitCommand"
aMenu.Parameter = "Datei beenden"
aMenu.BeginGroup = True 'Fügt Trennlinie vor Menüpunkt ein
End With
'Demo-Menü füllen
With myMenuBar.Controls("Demo").Controls
'Ersten Demo-Befehl hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "&Erster Befehl"
aMenu.OnAction = "DummyCommand"
aMenu.Parameter = "Demo Eins"
'Zweiten Demo-Befehl hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "&Zweiter Befehl"
aMenu.OnAction = "DummyCommand"
aMenu.Parameter = "Demo Zwei"
'Untermenü zum Menü hinzufügen, als Popup-Menü
Set aMenu = .Add(Type:=msoControlPopup, temporary:=True)
aMenu.Caption = "&Untermenü"
aMenu.BeginGroup = True 'Fügt Trennlinie vor Menüpunkt ein
End With
'Menü Demo|Untermenü füllen
With myMenuBar.Controls("Demo").Controls("Untermenü").Controls
'Menüeintrag für Demo von Umschalten einer Markierung hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "Markierung einschalten"
aMenu.OnAction = "CheckToggle"
'Menüeintrag für Demo von Umschalten einer Schaltfläche hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "Option einschalten"
aMenu.FaceId = MugIcon
aMenu.OnAction = "ButtonToggle"
'Menüeintrag mit Trennlinie hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "Befehl&1"
aMenu.OnAction = "DummyCommand"
aMenu.Parameter = aMenu.Caption
aMenu.BeginGroup = True
'Einen weiteren leeren Befehl hinzufügen
Set aMenu = .Add(Type:=msoControlButton, temporary:=True)
aMenu.Caption = "Befehl&2"
aMenu.OnAction = "DummyCommand"
aMenu.Parameter = aMenu.Caption
End With
myMenuBar.Visible = True 'Menü aktivieren
End Sub
Sub CheckToggle()
'Schaltet die Markierung um, ändert die Beschriftung
With CommandBars("Demo-Menü").Controls("Demo")
With .Controls("Untermenü").Controls(1)
If .State = msoButtonUp Then
.State = msoButtonDown
.Caption = "Markierung ausschalten"
Else
.State = msoButtonUp
.Caption = "Markierung einschalten"
End If
End With
End With
End Sub
Sub ButtonToggle()
'Schaltet die Schaltfläche um, ändert die Beschriftung
With CommandBars(MenuName).Controls(ÒDemoÓ)
With .Controls("Untermenü").Controls(2)
If .State = msoButtonUp Then
.State = msoButtonDown
.Caption = "Option ausschalten"
Else
.State = msoButtonUp
.Caption = "Option einschalten"
End If
End With
End With
End Sub
Sub DummyCommand()
'Zeigt ein Meldungsfeld an, die Ausführung eines Befehls simuliert
Dim CmdCtrl As Object
Set CmdCtrl = CommandBars.ActionControl
If CmdCtrl Is Nothing Then Exit Sub
MsgBox prompt:="Simulation des Befehls " & _
CmdCtrl.Parameter, _
Buttons:=vbInformation, _
Title:="Demonstration des Menüsystems"
End Sub
Sub ExitCommand()
'Entfernt die benutzerdefinierte Befehlsleiste
CommandBars(MenuName).Delete
End Sub