Symbolleisteneintrag ruft Sub in falscher xla auf
Adleano
ich brauche bitte Eure Hilfe beim Thema Symbolleisten, die per VBA und Addin generiert werden.
Ich habe zwei xla-Dateien, eine heißt makros.xla und eine heißt makros_text.xla. Beide sind als Addin in Excel eingebunden und werden beim Öffnen von Excel über workbook_open zuerst gelöscht und dann neu erstellt.
Ziel des ganzen ist es eine Produktivumgebung und eine Testumgebung zu realisieren.
Beide Symbolleisten werden auch korrekt angezeigt. Nur wenn ich jetzt einen Eintrag aus der Testumgebungs-Symbolleiste auswähle startet Excel immer die Routine aus dem Produktivsystem (makros.xla). Woran liegt das? Hier der Code den ich dafür verwende:
Option Explicit
'PRODUKTIVSYSTEM
Option Private Module
Private Const constCBName As String = "VBA-Tool V5 (14.03.2011)" 'Symbolleistenname Produktivsystem
Public cbSymbolleiste As CommandBar
'TESTSYSTEM
Private Const constCBName_Test As String = "VBA-Tool V5-TEST (14.03.2011)" 'Symbolleistenname Testsystem
Public cbSymbolleiste_Test As CommandBar
'Symbolleiste für PRODUKTIVSYSTEM
Sub Symbolleiste_erstellen()
Dim cmbbutton As CommandBarButton 'Befehlsschaltfläche
Dim cmbpopup(1 To 5) As CommandBarPopup 'Anzahl der Haupt-Menüeinträ _
ge festlegen (Listboxeinträge)
Dim strPfadxla As String 'Pfad der Makros.xla Datei
Dim strPfadUpdate As String 'Pfad zur Updateroutine
Dim i As Integer 'Indexierungsvariable zur _
Menüerstellung (Hauptmenükategorien)
'Pfad für Makros.xla
strPfadxla = "'C:\makros\makros.xla'!"
i = 1
'bestehende Symbolleiste löschen
Call DeleteCommandBar(True)
'Neue Symbolleiste hinzufügen
Set cbSymbolleiste = Application.CommandBars.Add(Name:=constCBName, _
Position:=msoBarTop, MenuBar:=False, temporary:=True) 'frei = _
msoBarFloating
'BESCHREIBUNG DER SYMBOLLEISTE (VERSIONSANGABE)
Set cmbbutton = cbSymbolleiste.Controls.Add(Type:=msoControlButton)
With cmbbutton
.FaceId = 956 ' _
Art des Symbols
.Caption = "Version " & VBA.Right(constCBName, 14) ' _
Version
.Style = msoButtonIconAndCaption ' _
Art de Beschriftung angeben (dis ist Symbol und Text)
.TooltipText = "Symbolleiste Excel VBA-Tool" ' _
Tooltip beim draufzeigen
.Enabled = False ' _
Anklicken nicht möglich --> grau schattierte Darstellung
End With
'STAMMDATEN
i = i + 1
Set cmbpopup(i) = cbSymbolleiste.Controls.Add(Type:=msoControlPopup)
With cmbpopup(i)
.BeginGroup = True
.Caption = "Stammdaten"
End With
'Fahrzeug anlegen
Call Menueintrag(cmbpopup(i), 374, "Anlegen", strPfadxla & "Anlage", "1")
'Fahrzeugdaten aktualisieren
Call Menueintrag(cmbpopup(i), 688, "Aktualisieren", strPfadxla & "Aktualsieren", "2")
'Eigenschaften der Symbolleiste setzen
With cbSymbolleiste
.Protection = msoBarNoCustomize + msoBarNoResize _
+ msoBarNoChangeVisible
.Visible = True
End With
Set cmbbutton = Nothing
Set cmbpopup(1) = Nothing
End Sub
' T E S T S Y S T E M ' T E S T S Y S T E M ' T E S T S Y S T E M ' T E S T S Y S T E M
Sub Symbolleiste_Testsystem()
Dim cmbbutton As CommandBarButton 'Befehlsschaltfläche
Dim cmbpopup_test(1 To 5) As CommandBarPopup 'Anzahl der Haupt- _
Menüeinträge festlegen
Dim strPfadUpdate As String, strPfadxla As String 'Pfad der Makros.xla _
Datei
Dim i As Integer 'Indexierungsvariable zur _
Menüerstellung (Hauptmenükategorien)
i = 1
'Pfad für Makros.xla
strPfadxla = "'C:\makros\Testsystem\makros_test.xla'!"
Call prcDeleteCommandBar(True) 'Symbolleiste löschen
'BESCHREIBUNG DER SYMBOLLEISTE (VERSIONSANGABE)
Set cbSymbolleiste_Test = Application.CommandBars.Add(Name:=constCBName_Test, _
Position:=msoBarTop, MenuBar:=False, temporary:=True) 'frei = _
msoBarFloating
'BESCHREIBUNG DER SYMBOLLEISTE (VERSIONSANGABE)
Set cmbbutton = cbSymbolleiste_Test.Controls.Add(Type:=msoControlButton)
With cmbbutton
.FaceId = 482 'Art des Symbols
.Caption = "Version " & VBA.Right(constCBName, 14) & "_Test" 'Version
.Style = msoButtonIconAndCaption 'Art de _
Beschriftung angeben (dis ist Symbol und Text)
.TooltipText = "Symbolleiste VBA-Tool TEST" 'Tooltip beim draufzeigen
.Enabled = False 'Anklicken nicht _
möglich --> grau schattierte Darstellung
End With
'STAMMDATEN
i = i + 1
'Hauptmenüpunkt: Achtung Abweichung zu Prodsystem
Set cmbpopup_test(i) = cbSymbolleiste_Test.Controls.Add(Type:=msoControlPopup)
With cmbpopup_test(i)
.BeginGroup = True
.Caption = "Fahrzeug-/DL-Daten"
End With
'Anlegen
Call Menueintrag(cmbpopup_test(i), 374, "Anlegen", strPfadxla & "Anlegen", "1", "true")
'Fahrzeugdaten aktualisieren
Call Menueintrag(cmbpopup_test(i), 688, "Aktualisieren", strPfadxla & "Aktualisieren", "2")
'Eigenschaften der Symbolleiste setzen
With cbSymbolleiste_Test _
'Achtung Abweichung zu Prodsystem
.Protection = msoBarNoCustomize + msoBarNoResize _
+ msoBarNoChangeVisible
.Visible = True
End With
Set cmbbutton = Nothing
Set cmbpopup_test(1) = Nothing
End Sub
'Funktion: Fügt einen Menüeintrag zur Symbolleiste hinzu
Sub Menueintrag(cmbpopup As CommandBarPopup, intFaceid As Integer, strCaption As String, _
strAction As String, strTag As String, Optional strTestsystem As String)
Dim cmbbutton As CommandBarButton
Set cmbbutton = cmbpopup.Controls.Add(Type:=msoControlButton)
With cmbbutton
.FaceId = intFaceid
.Caption = strCaption
.OnAction = strAction
.Style = msoButtonIconAndCaption
.Tag = strTag
End With
Set cmbbutton = Nothing
End Sub
'Symbolleiste löschen
Sub DeleteCommandBar(blnAufruf As Boolean)
Dim intIndex As Integer
On Error Resume Next
'Produktivsystem
If blnAufruf = False Then
If Not cbSymbolleiste Is Nothing Then
cbSymbolleiste.Delete
Set cbSymbolleiste = Nothing
End If
For Each cbSymbolleiste In Application.CommandBars
If cbSymbolleiste.Name = constCBName Then cbSymbolleiste.Delete _
'VBA-Symbolleiste löschen
Next
'Testsystem
ElseIf blnAufruf = True Then
If Not cbSymbolleiste_Test Is Nothing Then
cbSymbolleiste_Test.Delete
Set cbSymbolleiste_Test = Nothing
End If
For Each cbSymbolleiste_Test In Application.CommandBars
If cbSymbolleiste_Test.Name = constCBName_Test Then cbSymbolleiste_Test.Delete _
'VBA-Symbolleiste löschen
Next
End If
End Sub
Vielen Dank schon einmal.