Trennlinien in selbsterstellter Symbolleiste
04.02.2009 09:29:00
Florian
Ich hab mir einen Code zum Erstellen einer eigenen Symbolleiste aus dem Forum kopiert!
Ich hab jetzt nur noch das Problem, dass ich Probleme mit den Trennlinien habe.
In der Zeile
"Set CBC = CB.Controls.Add(ID:=128) 'Rückgängig"
tritt ein Fehler auf, d. h. der Code wird ab hier nicht mehr ausgeführt. Was hab ich hier falsch gemacht?
Ich kenn mich hier zu wenig aus, mein Latein ist hier am Ende!
Hier ist mein Versuch:
Private Sub Workbook_Open()
Dim CB As CommandBar
Dim CBC As CommandBarButton
Dim I As Integer
On Error Resume Next
Set CB = Application.CommandBars.Add(Name:="Menüleiste Durchschreibe", temporary:=True, _
Position:=msoBarTop)
On Error GoTo 0
If Application.CommandBars("Menüleiste Durchschreibe").Visible = False Then
CB.Visible = True
' Code von jinx zur Position
' RowIndex 3 --> vor Standard-Symbolleiste
' Rowindex 4 --> vor Formatsymbolleiste
CB.RowIndex = Application.CommandBars("Standard").RowIndex
' Left = 0 ---> wird vor existierende Symbolleiste eingefügt
' Left > 0 --> Wird hinter Symbolleiste angefügt
CB.Left = 0
'Application.CommandBars("Formatting").Visible = False
'Application.CommandBars("Standard").Visible = False
Set CBC = CB.Controls.Add(ID:=3) 'Speichern
Set CBC = CB.Controls.Add(ID:=4) 'Druckfenster
CBC.BeginGroup = True
Set CBC = CB.Controls.Add(ID:=109) ' Seitenansicht
Set CBC = CB.Controls.Add(ID:=19) ' Kopieren
CBC.BeginGroup = True
CB.Controls.Add ID:=6002 ' Einfügen
Set CBC = CB.Controls.Add(ID:=128) 'Rückgängig
CBC.BeginGroup = True
Set CBC = CB.Controls.Add(ID:=37) 'Wiederholen
For I = 1 To 8
Set CBC = CB.Controls.Add(Type:=msoControlButton)
With CBC
Select Case I
Case 1
ThisWorkbook.Worksheets("Icons").Shapes("Bild 1").Copy
.Caption = "Format: Auswertung"
.OnAction = "Format_Auswertung"
.Style = msoButtonIcon
.PasteFace
.BeginGroup = True
Case 2
ThisWorkbook.Worksheets("Icons").Shapes("Bild 2").Copy
.Caption = "Fußzeile"
.OnAction = "Fußzeile_einfügen"
.Style = msoButtonIcon
.PasteFace
Case 3
ThisWorkbook.Worksheets("Icons").Shapes("Bild 3").Copy
.Caption = "CSV Speichern"
.OnAction = "CSV_als_XLS_Speichern"
.Style = msoButtonIcon
.PasteFace
.BeginGroup = True
Case 4
ThisWorkbook.Worksheets("Icons").Shapes("Bild 4").Copy
.Caption = "Querformat"
.OnAction = "Querformat"
.Style = msoButtonIcon
.PasteFace
.BeginGroup = True
Case 5
ThisWorkbook.Worksheets("Icons").Shapes("Bild 5").Copy
.Caption = "Seitenrand vergrößern"
.OnAction = "Seitenrand_vergroessern"
.Style = msoButtonIcon
.PasteFace
Case 6
ThisWorkbook.Worksheets("Icons").Shapes("Bild 6").Copy
.Caption = "Automatischer Seitenumbruch"
.OnAction = "Automatischer_Seitenumbruch"
.Style = msoButtonIcon
.PasteFace
.BeginGroup = True
Case 7
ThisWorkbook.Worksheets("Icons").Shapes("Bild 7").Copy
.Caption = "Als Datum"
.OnAction = "Als_DATUM_formatieren"
.Style = msoButtonIcon
.PasteFace
.BeginGroup = True
Case 8
ThisWorkbook.Worksheets("Icons").Shapes("Bild 8").Copy
.Caption = "Als TEXT/ZAHL formatieren"
.OnAction = "Als_TEXT_formatieren"
.Style = msoButtonIcon
.PasteFace
End Select
End With
Next I
End If
End Sub
Bitte um Eure Hilfe!
Gruß
Florian