|
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
|
|
|
|
|
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: [ 2023 ]
|
|
|