Symbolleisten erzeugen
12.01.2007 16:51:37
Alex
ich möchte mir eine dynamische Symbolleiste erzeugen, die sich beim Starten einer bestimmten Datei öffnen soll. Hab dazu erstmal was aus anderen Quellen kopiert. Der Aufruf klappt dummerweise nur einmal - dann kommt der Laufzeitfehler '5'. Das kann ich verhindern, wenn ich den Namen vorher ändere. Keine Ahnung, was da passiert.
Hier mein Code:
Public objCBar As Office.CommandBar
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Application.CommandBars("FiltereiAlexAAAS").Visible = False
End Sub
Private Sub Workbook_Open()
Dim strOnAction As String
'DeleteCommandBar
'On Error GoTo err_CreateCommandBar
Set objCBar = ThisWorkbook.Application.CommandBars.Add( _
Name:="Filtere", Temporary:=True)
!!!!!!!!!!!!!!!!!!!!!!LAUFZEITFEHLER 5!!!!!!!!!!!!!!!!!
strOnAction = "'" & ThisWorkbook.Name & "'!modOnAction."
With objCBar
With .Controls.Add(Type:=msoControlButton)
.BeginGroup = True
.Style = msoButtonCaption
.Caption = "Demo Button 1"
.Tag = gcCBARBTN_TAG
.OnAction = strOnAction & "OnAction_DemoAddIn_11"
End With
With .Controls.Add(Type:=msoControlButton)
.Style = msoButtonCaption
.Caption = "Demo Button 2"
.Tag = gcCBARBTN_TAG
.OnAction = strOnAction & "OnAction_DemoAddIn_12"
End With
With .Controls.Add(Type:=msoControlButton)
.BeginGroup = True
.Style = msoButtonIcon
.FaceId = 3021
.Parameter = <a href=""http://www.vb-fun.de"">"http://www.vb-fun.de"</a>
.TooltipText = "VB-fun-Startseite"
.OnAction = strOnAction & "OnAction_GoToVBfun_13"
On Error Resume Next
TCBarPics.Shapes("picVBFun").CopyPicture
If Err.Number = 0 Then
.PasteFace
End If
On Error GoTo 0
End With
.Position = msoBarTop
.Visible = True
.Protection = msoBarNoCustomize
End With
exit_Sub:
On Error Resume Next
Set objCBar = Nothing
On Error GoTo 0
Exit Sub
err_CreateCommandBar:
MsgBox "Es ist ein Fehler bei der Erstellung der neuen " & _
vbCrLf & "Symbolleiste aufgetreten !", vbCritical, _
gcAPP_NAME & " - Fehler"
'DeleteCommandBar
Resume exit_Sub
End Sub