CommandBars(1).Controls Problem
21.12.2003 16:55:29
Reinhard
zum Level, 'kaum' ist zu wenig, 'gut' ist zu viel*g
Folgende Makros sollen in der Standardsymbolleiste ein neues Menue "Marker" erstellen, wobei dann in das Menue 3-5 Befehle hineinsollen.
So, schon beim ersten Befehl also bei Commandbars(1).Controls("Marker").Controls(1) komme ich nicht weiter.
Es soll ein Toggle-Befehl werden, zum Ein- oder Ausschalten einer Funktion.
D.h. wenn die Funktion eingeschaltet ist soll der Befehl die Beschriftung "...Aus" haben und umgedreht.
Nach Öffnen der Arbeitsmappe wird alles korrekt ausgeführt. also das zusätzliche Menü mit dem Befehl wird erzeugt.
Beim allerersten Klick auf das Menü wird dann der Befehl angezeigt und bei Klick auf den Befehl wird dieser ausgeführt und wegen der Togglefunktion wechselt auch die Caption des Befehls korrekt.
Ab dann klappt es nicht mehr :-(
Sofort bei Klick auf das Menü ("Marke") wird die Sub "...Aus" ausgeführt, so dass mir dann bei Anzeige des Befehls immer "...Ein" angezeigt wird. Wie muss ich wo was einstellen sodass bei Klick auf das Menü "Marker" nur die Befehle aufklappen und nicht schon Befehle ausgeführt werden.
Viel Text wie immer wenn ich versuch was zu beschreiben, deshalb für Leute mit großer VBA-Erfahrung die Frage in Kurzform:
Bei Klick auf das Menü "Marker" wird (abgesehen vom ersten Klick darauf) immer schon das Makro "ÜberwachungAus"
ausgeführt. Wie stelle ich das ab, sodass nur die Befehle angezeigt werden?
Danke für Tipps oder gar Lösungen
Gruß
Reinhard
Im Modul1 steht:
Public Überwach As Boolean
Sub ÜberwachungEin()
Dim MB As CommandBarControl
Set MB = CommandBars(1).Controls("Marker")
With MB
.Controls(1).Caption = "&EingabeÜberwachung AUS"
.OnAction = "ÜberwachungAus"
End With
Überwach = True
ActiveSheet.Cells(Range("S65536").End(xlUp).Row + 1, "S") = "Ein"
Set MB = Nothing
End Sub
Sub ÜberwachungAus()
Dim MB As CommandBarControl
Set MB = CommandBars(1).Controls("Marker")
With MB
.Controls(1).Caption = "&EingabeÜberwachung EIN"
.OnAction = "ÜberwachungEin"
End With
Überwach = False
ActiveSheet.Cells(Range("S65536").End(xlUp).Row + 1, "S") = "Aus" 'Nur bis Fehler weg ist
Set MB = Nothing
End Sub
Im Modul2 steht:
Sub NeuesMenüEinfügen()
Dim i As Integer, i_Hilfe As Integer
Dim MenueNeu As CommandBarControl
Dim MB As CommandBarControl
'Anzahl vorhandener Menues zählen
i = Application.CommandBars(1).Controls.Count
'Position des Fragezeichens feststellen
i_Hilfe = Application.CommandBars(1).Controls(i).Index
'Neues Menue before, also links, vom Fragezeichen eintragen
Set MenueNeu = Application.CommandBars(1).Controls.Add _
(Type:=msoControlPopup, before:=i_Hilfe, temporary:=True)
'Beschriftung des neuen Menues
MenueNeu.Caption = "&Marker"
'erster Befehl eintragen
Set MB = MenueNeu.Controls.Add(Type:=msoControlButton)
With MB
.Caption = "&EingabeÜberwachung AUS"
.Style = msoButtonCaption
.OnAction = "ÜberwachungEin"
' .BeginGroup = True
' .State = msoButtonUp
End With
Set MB = Nothing
End Sub
Sub MenüLöschen()
'falls Fehler auftreten, zum Beispiel Menue Marker existiert nicht,
'mit nächstem Befehl weitermachen und Programm nicht abbrechen
On Error Resume Next
With Application.CommandBars(1)
.Controls("&Marker").Delete
End With
End Sub
In 'DieseArbeitsmappe' steht:
Private Sub Workbook_Open()
NeuesMenüEinfügen
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
MenüLöschen
End Sub