Fehler beim Erzeugen einer Symbolleiste
07.05.2008 08:53:00
Josef
Mit nachstehendem Code wird eine Symbolleiste erzeugt. Nur habe ich bei den letzten 2 Controls
"SUBKAPITEL NEU" und "CODE Zuordungen" ein Problem. Ich bekomme das ganze nur mit einem
"msoControlPopup" zum Laufen. Ich bräuchte jedoch bei diesen zwei Controls (10 und 11)
einen "msoControlButton". Leider gelingt mir das nicht . Wo könnte ich bitte hier den Fehler gemacht haben?
Danke
Josef
Sub Neue_Symbolleiste_DB2()
Dim objBtn As CommandBarButton
Dim wkb As Workbook
Dim cmdBar As CommandBar
Dim cntMenu As CommandBarPopup
Dim cntButton As CommandBarButton
Dim MeineSymbolleiste As CommandButton
Dim NeuesMakro As CommandButton
Dim Steuerelement2 As CommandButton
On Error Resume Next
CommandBars("SteuerungDB2").Delete 'löschen
CommandBars.Add Name:="SteuerungDB2" 'neu anlegen
With CommandBars("SteuerungDB2")
.Position = msoBarTop
.Visible = True
.Controls.Add Type:=msoControlButton '1 vorherige Seite
.Controls.Add Type:=msoControlDropdown '2 Blattauflistung
.Controls.Add Type:=msoControlButton '3 nächste Seite
End With
With CommandBars("SteuerungDB2").Controls(1)
.Width = 20
.TooltipText = "vorherige Seite anzeigen"
.Style = msoButtonIcon
.FaceId = 132
.OnAction = "Blatt_vorher_DB2"
End With
With CommandBars("SteuerungDB2").Controls(2)
Call BlattListe_DB2
.Width = 180
.TooltipText = "wechselt zur ausgewählten Seite"
.ListRows = 50
.ListIndex = 1
.OnAction = "Alle_Blätter"
End With
With CommandBars("SteuerungDB2").Controls(3)
.Width = 20
.TooltipText = "nächste Seite anzeigen"
.Style = msoButtonIcon
.FaceId = 133
.PicturePosition = 4
.OnAction = "Blatt_nachher_DB2"
End With
With CommandBars("SteuerungDB2").Controls(4)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "NEU"
cntMenu.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Neue PosNr. anlegen"
.OnAction = "NeuPos"
.Style = msoButtonIconAndCaption
.FaceId = 608
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Alte Werte löschen"
.OnAction = "NeuPosDel"
.Style = msoButtonIconAndCaption
.FaceId = 67
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Werteänderungen Gesundheitswesen"
.OnAction = "ÄndWerteKur"
.Style = msoButtonIconAndCaption
.FaceId = 742
.BeginGroup = True
End With
With CommandBars("SteuerungDB2").Controls(5)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "Werte NOVA"
cntMenu.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Bewertungen NEU"
.OnAction = "Werte_SL"
.Style = msoButtonIconAndCaption
.FaceId = 395
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Gehe zu Seite Werte NOVA"
.OnAction = "WERTENOVAAKT"
.Style = msoButtonIconAndCaption
.FaceId = 395
.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Bewertungszeilen kopieren (F6)"
.OnAction = "BewertungKopieren"
.Style = msoButtonIconAndCaption
.FaceId = 395
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Alle Bewertungszeilen löschen (F7)"
.OnAction = "BewertungLöschen"
.Style = msoButtonIconAndCaption
.FaceId = 67
End With
With CommandBars("SteuerungDB2").Controls(6)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "Im&portdateien"
cntMenu.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&1. Importdatei Ausprägungen(NOVA)speichern"
.OnAction = "Starte_Ausprägungen"
.Style = msoButtonIconAndCaption
.FaceId = 271
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&2. Importdatei Leistungen(NOVA)speichern"
.OnAction = "Starte_Leistungen"
.Style = msoButtonIconAndCaption
.FaceId = 271
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&3. Importdatei Bewertungen(NOVA)speichern"
.OnAction = "Starte_WerteNOVA"
.Style = msoButtonIconAndCaption
.FaceId = 271
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&4. Importdatei Fachgruppen(NOVA)speichern"
.OnAction = "Starte_Fachgruppen"
.Style = msoButtonIconAndCaption
.FaceId = 271
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&5. Importdatei Berechtigungen(NOVA)speichern"
.OnAction = "Starte_Berechtigungen"
.Style = msoButtonIconAndCaption
.FaceId = 271
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&6. Importdatei Bewertungsänderungen (GW) speichern"
.OnAction = "Starte_BewertungKur"
.Style = msoButtonIconAndCaption
.FaceId = 271
.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&7. Importdatei DB2 Kapitel speichern"
.OnAction = "Starte_DB2KAPITELNEU"
.Style = msoButtonIconAndCaption
.FaceId = 271
.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&8. Importdatei DB2 PosNR. speichern"
.OnAction = "Starte_DB2Korrekturen"
.Style = msoButtonIconAndCaption
.FaceId = 271
End With
With CommandBars("SteuerungDB2").Controls(7)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "&Korrekturen"
cntMenu.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&1. Importdatei DB2 PosNr. generieren"
.OnAction = "Kopieren"
.Style = msoButtonIconAndCaption
.FaceId = 173
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&2. Importdatei Bewertungsänderungen (KUR) generieren"
.OnAction = "KopierenKur"
.Style = msoButtonIconAndCaption
.FaceId = 173
End With
With CommandBars("SteuerungDB2").Controls(8)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "N&OVA und DB2 Tools"
cntMenu.BeginGroup = True
'cntMenu.TooltipText = "Emulation muß geöffnet sein"
End With
'Set cntButton = cntMenu.Controls.Add
' With cntButton
' .Caption = "Neue Daten zuordnen und Datensatznummern neu vergeben"
' .OnAction = "Markieren_Master"
' .Style = msoButtonIconAndCaption
' '.TooltipText = "Emulation muß geöffnet sein"
' .FaceId = 69
'End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&Freie PosNr."
.OnAction = "Starte_UF4"
.Style = msoButtonIconAndCaption
'.TooltipText = "Emulation muß geöffnet sein"
.FaceId = 49
.BeginGroup = True
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&Codeverwaltung DB2"
.OnAction = "Starte_UF5"
.Style = msoButtonIconAndCaption
'.TooltipText = "Emulation muß geöffnet sein"
.FaceId = 247
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&KUR Leistungspositionen"
.OnAction = "Starte_UF6"
.Style = msoButtonIconAndCaption
'.TooltipText = "Emulation muß geöffnet sein"
.FaceId = 247
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Ko&rrekturfälle zählen"
.OnAction = "Status"
.Style = msoButtonIconAndCaption
'.TooltipText = "Emulation muß geöffnet sein"
.FaceId = 1553
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&Importdateien verschieben"
.OnAction = "Starte_UF3"
.Style = msoButtonIconAndCaption
'.TooltipText = "Emulation muß geöffnet sein"
.FaceId = 1020
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "&Sicherungskopie erstellen"
.OnAction = "Sicherung"
.Style = msoButtonIconAndCaption
'.TooltipText = "Emulation muß geöffnet sein"
.FaceId = 271
End With
With CommandBars("SteuerungDB2").Controls(9)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "Mappen Wechsel"
cntMenu.BeginGroup = True
'cntMenu.TooltipText = "WOKE Zuordnungen"
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "WOKE Zuordnungsdatei in den Vordergrund"
.OnAction = "WOKEVG"
.Style = msoButtonIconAndCaption
.FaceId = 585
End With
Set cntButton = cntMenu.Controls.Add
With cntButton
.Caption = "Masterfile in den Vordergrund"
.OnAction = "MASTVG"
.Style = msoButtonIconAndCaption
.FaceId = 585
End With
With CommandBars("SteuerungDB2").Controls(10)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "SUBKAPITEL NEU"
cntMenu.BeginGroup = True
cntMenu.TooltipText = "Anlage neuer Kapitel sowie Subkapitel"
cntMenu.FaceId = 1553
cntMenu.OnAction = "Start_SubKap"
End With
With CommandBars("SteuerungDB2").Controls(11)
Set cmdBar = Application.CommandBars("SteuerungDB2")
Set cntMenu = cmdBar.Controls.Add(msoControlPopup, Before:=cmdBar.Controls.Count)
cntMenu.Caption = "CODE Zuordnungen"
cntMenu.BeginGroup = True
cntMenu.Style = msoButtonIconAndCaption
cntMenu.FaceId = 1553
cntMenu.OnAction = "Start_CODE_SFLB"
End With
End Sub