Re: Symbolleisten weg
11.03.2003 18:22:00
Jörg
Leider hat mir von den Vorschlägen hier nix geholfen. zurücksetzten hab ich schon probiert, und das mit unregserver hat leider auch nicht funktioniert :(Ich glaube, ... folgendes war der auslösende Code, bin aber nicht mehr sicher, da ja zuvor alles funktionierte und ich damit den Rest gelöscht habe. Aber dann aus heitrem Himmel, alles weg!
*************************************
rivate Sub Workbook_Open()
Dim cb As CommandBar
Dim CBC As CommandBarButton
Dim I%
On Error Resume Next
Set cb = Application.CommandBars.Add(Name:="Fächersprung", _
temporary:=True, Position:=msoBarTop)
' Oben Position:=msoBarTop
' Rechts Position:=msoBarRight
' Links Position:=msomsoBarLeft
' unten Position:=msoBarBottom
On Error GoTo 0
If Application.CommandBars("Fächersprung").Visible = False Then '
cb.Visible = True
' cb.Left = 10
' cb.Top = 150
For I = 1 To 15
Set CBC = cb.Controls.Add(Type:=msoControlButton)
With CBC
.Width = 50 ' Breite der Schalter
' .Style = msoButtonCaption ' Text auf Schaltfläche ohne Icon
.Style = msoButtonIconAndCaption ' Text uns Icon
Select Case I
Case 1
.FaceId = 67 ' Icon vor Beschriftung
.Caption = "IRB"
.OnAction = "Roboter"
.TooltipText = "Roboter einfügen"
Case 2
.Caption = "Ent."
.OnAction = "Entlader"
.TooltipText = "Entlader einfügen"
Case 3
.Caption = "LPM"
.OnAction = "LPM"
.TooltipText = "LPM einfügen"
Case 4
.Caption = "Bel."
.OnAction = "Belader"
.TooltipText = "Belader einfügen"
Case 5
.Caption = "PTS"
.OnAction = "PTS"
.TooltipText = "PTS Einfügen"
Case 6
.BeginGroup = True 'neue Gruppe Hinweis Christoph Dümmen
.Caption = "KTS"
.OnAction = "Gebindetransport"
.TooltipText = "Gebindetransport einfügen"
Case 7
.Caption = "S.S."
.OnAction = "SS"
.TooltipText = "Schalt- und Steuerausrüstung einfügen"
Case 8
.Caption = "Aus."
.OnAction = "Auspacker"
.TooltipText = "Auspacker einfügen"
Case 9
.Caption = "Ein."
.OnAction = "Einpacker"
.TooltipText = "Einpacker einfügen"
Case 10
.Caption = "ET60.1"
.OnAction = "ET601"
.TooltipText = "ET 60.1 einfügen"
Case 11
.Caption = "ET 85"
' .OnAction = "ET85"
' .TooltipText = "ET 85 einfügen"
.Enabled = False
Case 12
.Caption = "Kopfpa."
.OnAction = "Kopfpalette"
.TooltipText = "Kopfpalettenaufleger einfügen"
Case 13
.Caption = "NGA"
.OnAction = "NGA"
.TooltipText = "Neuglasabheber einfügen"
Case 14
.Caption = "NGS"
.OnAction = "NGS"
.TooltipText = "Neuglasabschieber einfügen"
Case 15
.Caption = "Zu."
.OnAction = "Zukauf"
.TooltipText = "Zukauf einfügen"
End Select
End With
Next I
End If
End Sub
Private Sub Workbook_Deactivate()
' Schaltflächen nicht auswählbar bei Blattwechsel
' Dim I as Byte
' With Application.CommandBars("Fächersprung")
' For I = 1 To 15
' .Controls(I).Enabled = False
' Next I
' End With
On Error Resume Next
If Application.CommandBars("Fächersprung").Visible = True Then
Application.CommandBars("Fächersprung").Visible = False
End If
End Sub
Private Sub Workbook_Activate()
On Error GoTo neu
If Application.CommandBars("Fächersprung").Visible = False Then
Application.CommandBars("Fächersprung").Visible = True
End If
Exit Sub
neu:
Workbook_Open
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Fächersprung").Delete
End Sub
Private Sub Workbook_SheetSelectionChange2(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error GoTo neu
If Application.CommandBars("Fächersprung").Visible = False Then
Application.CommandBars("Fächersprung").Visible = True
End If
Exit Sub
neu:
Workbook_Open
End Sub