AW: Symbolleiste
21.07.2008 14:21:00
Heiko
Hallo Martin
danke für deine hilfe aber es klappt noch nicht so richtig. Der 2 Button müßte genau so aussehen wie der erste mit dem FaceID usw.
Private Sub Workbook_Open()
Application.Caption = "eigene Symbolleiste"
Dim cb As CommandBar
Dim CBC1 As CommandBarControl, CBC2 As CommandBarControl
Dim i1 As Integer, i2 As Integer, i3 As Integer
On Error Resume Next
Application.CommandBars("Leiste").Delete
Set cb = Application.CommandBars.Add(Name:="Leiste", _
temporary:=True, Position:=msoBarTop)
On Error GoTo 0
If Application.CommandBars("Leiste").Visible = False Then
cb.Visible = True
For i1 = 1 To 2
Set CBC1 = cb.Controls.Add(Type:=msoControlPopup)
With CBC1
.Width = 50 ' Breite der Schalter
''.Style = msoButtonIconAndCaption ' Text und Icon
Select Case i1
Case 1
'.FaceId = 576 ' Icon vor Beschriftung
.Caption = "Tippscheine"
'.OnAction = "Makro1"
.TooltipText = "Tooltip noch überlegen"
For i2 = 1 To 6
Set CBC2 = CBC1.Controls.Add(Type:=msoControlButton)
With CBC2
.Width = 50 ' Breite der Schalter
.Style = msoButtonIconAndCaption ' Text und Icon
Select Case i2
Case 1
.FaceId = 266 ' Icon vor Beschriftung
.Caption = "Tippschein_1"
.OnAction = "Schein1"
.TooltipText = "Tooltip noch überlegen"
Case 2
.FaceId = 59 ' Icon vor Beschriftung
.Caption = "Tippschein_2"
.OnAction = "Schein2"
.TooltipText = "Tooltip noch überlegen"
Case 3
.FaceId = 481 ' Icon vor Beschriftung
.Caption = "Tippschein_3"
.OnAction = "Schein3"
.TooltipText = "Tooltip noch überlegen"
Case 4
.FaceId = 482 ' Icon vor Beschriftung
.Caption = "Tippschein_4"
.OnAction = "Schein4"
.TooltipText = "Tooltip noch überlegen"
Case 5
.FaceId = 483 ' Icon vor Beschriftung
.Caption = "Tippschein_5"
.OnAction = "Schein5"
.TooltipText = "Tooltip noch überlegen"
Case 6
.FaceId = 484 ' Icon vor Beschriftung
.Caption = "Tippschein_6"
.OnAction = "Schein6"
.TooltipText = "Tooltip noch überlegen"
End Select
End With
Next i2
Case 2
''.FaceId = 59 ' Icon vor Beschriftung
.Caption = "Eingaben"
''.OnAction = "Makro2"
.TooltipText = "Tooltip noch überlegen"
For i2 = 1 To 6
Set CBC2 = CBC1.Controls.Add(Type:=msoControlEdit)
With CBC2
.Width = 50 ' Breite der Schalter
'.Style = msoButtonIconAndCaption ' Text und Icon
Select Case i2
Case 1
.FaceId = 266 ' Icon vor Beschriftung
.Caption = "Tippschein_1"
.OnAction = "Schein1"
.TooltipText = "Tooltip noch überlegen"
Case 2
.FaceId = 59 ' Icon vor Beschriftung
.Caption = "Tippschein_2"
.OnAction = "Schein2"
.TooltipText = "Tooltip noch überlegen"
Case 3
.FaceId = 481 ' Icon vor Beschriftung
.Caption = "Tippschein_3"
.OnAction = "Schein3"
.TooltipText = "Tooltip noch überlegen"
Case 4
.FaceId = 482 ' Icon vor Beschriftung
.Caption = "Tippschein_4"
.OnAction = "Schein4"
.TooltipText = "Tooltip noch überlegen"
Case 5
.FaceId = 483 ' Icon vor Beschriftung
.Caption = "Tippschein_5"
.OnAction = "Schein5"
.TooltipText = "Tooltip noch überlegen"
Case 6
.FaceId = 484 ' Icon vor Beschriftung
.Caption = "Tippschein_6"
.OnAction = "Schein6"
.TooltipText = "Tooltip noch überlegen"
End Select
End With
Next i2
End Select
End With
Next i1
End If
End Sub
Wenn ich den Code so mache bekomme ich aber eine fehlermeldung. DAnn müßten meine 2 Buttons in die Hauptleiste hinter das Fragezeichen. Ich krieg das glaube ich nicht hin.
Gruß Heiko