Tipp 0088 Symbolleiste - eigene Grafiken integrieren -1-
Autor/Einsender:
Datum:
  Angie
29.01.2006 (Update)
Entwicklungsumgebung:   Excel 2000
Gerade in Excel ist es sinnvoll eigene Symbolleisten (CommandBars) dynamisch zu erstellen, also z. B. beim Öffnen einer Arbeitsmappe oder AddIns. In diesem Beispiel wird unter anderem gezeigt, wie sich eine eigene Grafik auf einem Schaltflächen-Steuerelement (CommandBarButton) integrieren lässt. Hier liegt die einzufügende Grafik als GIF-Datei vor. Diese wird zunächst als Grafik in ein Tabellenblatt eingefügt, mit der Methode CopyPicture in die Zwischenablage kopiert und anschließend mit der Methode PasteFace auf die entsprechende Schaltfläche eingefügt.
Code im Codebereich von DieseArbeitsmappe
 
Option Explicit

Private Const mc_CBAR_NAME      As String = "VB-fun-Symbolleiste"
Private Const mc_ICON_FILENAME  As String = "VBFun32x32.gif"

Private Sub Workbook_Open()
  Call CreateCommandBar
  ThisWorkbook.Saved = True
End Sub

Private Sub CreateCommandBar()
  Dim objCBar     As Office.CommandBar
  Dim objCBBtn    As Office.CommandBarButton

  Dim strPath     As String
  Dim strFileName As String

  Call DeleteCommandBar

  On Error GoTo err_CreateCommandBar
  Set objCBar = Application.CommandBars.Add( _
          Name:=mc_CBAR_NAME, Temporary:=True)

  With objCBar
    .Visible = True
    .Position = msoBarTop
    .Protection = msoBarNoCustomize
  End With

  Set objCBBtn = objCBar.Controls.Add(Type:=msoControlButton)
  With objCBBtn
    .Style = msoButtonIconAndCaption
    .Caption = "VB-fun-Startseite"
    .Parameter = "http://www.vb-fun.de"
    .TooltipText = .TooltipText
    .OnAction = "OnActionVBfun"
  End With

  strPath = ThisWorkbook.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

  strFileName = strPath & mc_ICON_FILENAME
  If FileExists(strFileName) Then
    Dim objPicture As Object

    On Error Resume Next
    Set objPicture = ThisWorkbook.Worksheets(1) _
          .Pictures.Insert(strFileName)
    objPicture.CopyPicture
    objPicture.Delete
    Set objPicture = Nothing

    Err.Clear
    objCBBtn.PasteFace
    If Err.Number <> 0 Then
      objCBBtn.FaceId = 3021
    End If

  Else
      objCBBtn.FaceId = 3021
  End If

exit_Sub:
    On Error Resume Next

    Set objCBBtn = Nothing
    Set objCBar = Nothing

    On Error GoTo 0
    Exit Sub

err_CreateCommandBar:
  MsgBox "Es ist ein Fehler bei der Erstellung der neuen " & _
          vbCrLf & "Symbolleiste aufgetreten !", vbExclamation, _
          Title:="Fehler beim Erstellen der Symbolleiste"
  Call DeleteCommandBar
  Resume exit_Sub
End Sub

Private Sub DeleteCommandBar()
  On Error Resume Next
  Application.CommandBars(mc_CBAR_NAME).Delete
  On Error GoTo 0
End Sub

Private Function FileExists(sFileName As String) As Boolean
  On Error Resume Next
  FileExists = Dir$(sFileName) <> ""
  FileExists = FileExists And Err = 0
  On Error GoTo 0
End Function
 
Soll die Symbolleiste nur dann sichtbar sein, wenn die Arbeitsmappe aktiviert ist, mit der die Symbolleiste erstellt wurde, ist weiterer Code im Codebereich von DieseArbeitsmappe notwendig. Mit den Ereignissen Workbook_WindowActivate und Workbook_WindowDeActivate wird das Ein- und Ausblenden der Symbolleiste "gesteuert".
 
Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
  Call EnableCommandBar(True)
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)
  Call EnableCommandBar(False)
End Sub

Private Sub EnableCommandBar(ByVal Enabled As Boolean)
  On Error Resume Next
  Application.CommandBars(mc_CBAR_NAME).Enabled = Enabled
  On Error GoTo 0
End Sub
 
Code im Codebereich eines Moduls
Beim Hinzufügen der Schaltfläche zur Symbolleiste wird die OnAction-Eigenschaft zugewiesen, also der Name des Makros, das ausgeführt wird, wenn der Benutzer auf das Symbolleisten-Steuerelement klickt. In diesem Beispiel wird im OnAction-Makro mit Hilfe der API-Funktion ShellExecute unsere Internet-Seite im Standard-Browser geöffnet. Die Adresse wurde der Parameter-Eigenschaft des Steuerelements zugewiesen.
 
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
        "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
        As String, ByVal lpFile As String, ByVal lpParameters _
        As String, ByVal lpDirectory As String, ByVal nShowCmd _
        As Long) As Long

Sub OnActionVBfun()
  Dim nRetVal As Long

  If Not Application.CommandBars.ActionControl Is Nothing Then
    With Application.CommandBars.ActionControl
      If Len(.Parameter) > 0 Then
        nRetVal = ShellExecute(0&, "open", .Parameter, _
              vbNullString, vbNullString, vbNormalFocus)

        If nRetVal < 32 Then
          MsgBox "Es ist ein Fehler aufgetreten!", _
               vbInformation, "VB-fun-Demo"
        End If
      End If
    End With
  End If
End Sub
 
Weitere Links zum Thema
Symbolleiste - eigene Grafiken integrieren -2-

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Excel-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (17,2 kB) Downloads bisher: [ 1952 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 28. August 2011