Autor: Max Kaffl (Nepumuk) --- Aus Excel VBA - Gruppe:
TutorialsSymbolleisten (2) - Erzeugen und mehr!
Autor: Max Kaffl (Nepumuk) - Erstellt: -- - Letzte Revision: --Gruppenthema: 5 Folgen 1 2 3 4 5 Sie sind in Folge:2
Wie füge ich eine neue Symbolleiste ein.
Dieses mal werden wir eine freischwebende Symbolleiste in eine Mappe einfügen.
Dazu müssen sie als erstes ein kleines Bild in eine neue Mappe einfügen, welches als Symbol für eine Commandbarbutton benötigt wird. Das Bild sollte nicht allzu groß sein und möglichst quadratisch. Es muss den Namen "Bild 1" haben. Diesen können sie im Bedarfsfall über das Namensfeld (ganz links in der Bearbeitungsleiste) ändern. Fehlt dieses Bild, wird eine Fehlermeldung ausgegeben und ein Standardsymbol verwendet.
Die Leiste bekommt alle verfügbaren Commandbarcontrols:
1. Einen Button mit variabler Parameterübergabe.
2. Einen Button mit Hyperlinkfunktion.
3. Ein Edit - Control mit einem Button zum suchen in Tabellen.
4. Ein Popup - Control mit Buttons und Untermenü.
5. Ein Combobox - Control zur Tabellenauswahl.
6. Ein Dropdown - Control zum eingeben von standardisierten Begriffen.
Kopieren sie folgenden Code in ein Standardmodul.
Achtung, starten sie die Prozedur diesmal nicht sofort, da es sonst nur Fehlermeldungen hagelt, denn die dazugehörigen Routinen kommen erst nach und nach dazu.
Option Explicit
Option Private Module
Private Const COMMANDBAR_NAME As String = "Privat"
Public myCommandBar As CommandBar
Private myCommandBarComboBox(1 To 3) As CommandBarComboBox
Public Sub prcCreateCommandBar()
Dim myCommandBarButton As CommandBarButton
Dim myCommandBarPopup(1 To 2) As CommandBarPopup
Dim myShape As Shape
Dim myWorksheet As Worksheet
Dim bolFound As Boolean
Dim strFilename As String
Dim datFiledate As Date
On Error GoTo Err_exit
For Each myWorksheet In ThisWorkbook.Worksheets
For Each myShape In myWorksheet.Shapes
If myShape.Name = "Bild 1" Then
myShape.Copy
bolFound = True
Exit For
End If
Next
If bolFound Then Exit For
Next
If Not bolFound Then Err.Raise Number:=vbObjectError + 513, _
Description:="Es wurde kein Bild mit dem Namen ''Bild 1'' gefunden."
Call prcDeleteCommandBar
datFiledate = DateAdd("m", -1, Date)
strFilename = ThisWorkbook.Path & "\" & MonthName(Month(datFiledate)) _
& CStr(Year(datFiledate)) & ".xls"
Set myCommandBar = Application.CommandBars.Add(Name:=COMMANDBAR_NAME, _
Position:=msoBarFloating, MenuBar:=False, Temporary:=True)
Set myCommandBarButton = myCommandBar.Controls.Add(Type:=msoControlButton)
With myCommandBarButton
.FaceId = 263
.Caption = "Aktion"
'******************************** Msgbox ausgeben **************
' .OnAction = "prcAction1(""" & strFilename & """)"
'******************************** Formel einfügen **************
.OnAction = ThisWorkbook.Name & "!'prcAction2 """ _
& Selection.Address(ReferenceStyle:=xlR1C1, external:=True) & """'"
'***************************************************************
.Style = msoButtonIconAndCaption
.TooltipText = "Hier klicken um die Aktion auszuführen."
End With
Set myCommandBarButton = myCommandBar.Controls.Add(Type:=msoControlButton)
With myCommandBarButton
.BeginGroup = True
If bolFound Then .PasteFace Else .FaceId = 1576
'***************************** Datei öffnen ********************
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.TooltipText = "http://www.online-excel.de/" ' Internetsite öffnen
' .TooltipText = "mailto:XX@yahoo.de?subject=Hallo" ' Maileditor öffnen
' .TooltipText = strFilename ' Datei öffnen
'******************************** Bild einfügen ********************
' .HyperlinkType = msoCommandBarButtonHyperlinkInsertPicture 'Bild einfügen
' .TooltipText = "D:\Eigene Dateien\Eigene Bilder\014.gif"
'********************************************************************
.Style = msoButtonIcon
End With
Set myCommandBarComboBox(1) = _
myCommandBar.Controls.Add(Type:=msoControlEdit)
With myCommandBarComboBox(1)
.BeginGroup = True
.Width = 100
.OnAction = "prcSearch"
.TooltipText = "Hier den Suchbegriff eingeben."
End With
Set myCommandBarButton = _
myCommandBar.Controls.Add(Type:=msoControlButton)
With myCommandBarButton
.FaceId = 141
.Caption = "&Weitersuchen"
.OnAction = "prcSearch"
.Style = msoButtonIconAndCaption
.TooltipText = "Zum weitersuchen hier klicken."
End With
Set myCommandBarPopup(1) = _
myCommandBar.Controls.Add(Type:=msoControlPopup)
With myCommandBarPopup(1)
.BeginGroup = True
.Caption = "Menü 1"
End With
Set myCommandBarButton = _
myCommandBarPopup(1).Controls.Add(Type:=msoControlButton)
With myCommandBarButton
.FaceId = 264
.Caption = "Makro1"
.OnAction = "prcRamifyTag"
.Style = msoButtonIconAndCaption
.Tag = "1"
End With
Set myCommandBarButton = _
myCommandBarPopup(1).Controls.Add(Type:=msoControlButton)
With myCommandBarButton
.FaceId = 267
.Caption = "Makro2"
.OnAction = "prcRamifyTag"
.Style = msoButtonIconAndCaption
.Tag = "2"
End With
Set myCommandBarPopup(2) = _
myCommandBarPopup(1).Controls.Add(Type:=msoControlPopup)
myCommandBarPopup(2).Caption = "Menü 2"
Set myCommandBarButton = _
myCommandBarPopup(2).Controls.Add(Type:=msoControlButton)
With myCommandBarButton
.FaceId = 42
.Caption = "Makro3"
.OnAction = "prcRamifyTag"
.Style = msoButtonIconAndCaption
.Tag = "3"
End With
Set myCommandBarComboBox(2) = _
myCommandBar.Controls.Add(Type:=msoControlComboBox)
Call prcAddSheets
With myCommandBarComboBox(2)
.BeginGroup = True
.Width = 120
.DropDownWidth = 162
.OnAction = "prcSelect"
.Style = msoComboNormal
End With
Set myCommandBarComboBox(3) = _
myCommandBar.Controls.Add(Type:=msoControlDropdown)
Call prcAddItems
With myCommandBarComboBox(3)
.BeginGroup = True
.Width = 120
.DropDownWidth = 120
.OnAction = "prcEnter"
.Style = msoComboNormal
End With
With myCommandBar
.Top = 150
.Left = 50
.Protection = msoBarNoCustomize + msoBarNoResize _
+ msoBarNoChangeVisible + msoBarNoChangeDock
.Visible = True
End With
Set myCommandBarButton = Nothing
Set myCommandBarPopup(1) = Nothing
Set myCommandBarPopup(2) = Nothing
Exit Sub
Err_exit:
MsgBox "Fehler: " & CStr(Err.Number) & _
vbLf & vbLf & Err.Description, 16, "Fehlermeldung"
If Err.Number = vbObjectError + 513 Then Resume Next
Call prcDeleteCommandBar
End Sub
Public Sub prcDeleteCommandBar()
Dim intIndex As Integer
If Not myCommandBar Is Nothing Then
myCommandBar.Delete
Set myCommandBar = Nothing
For intIndex = 1 To 3
Set myCommandBarComboBox(intIndex) = Nothing
Next intIndex
Else
For Each myCommandBar In Application.CommandBars
If myCommandBar.Name = COMMANDBAR_NAME Then myCommandBar.Delete
Next
End If
End Sub
Die erste Aktion, die das Makro ausführt, ist die Suche nach dem "Bild 1" über alle Tabellen. Wird das Bild gefunden, wird es in die Zwischenablage kopiert. Dann wir noch ein Dateiname generiert, der als Parameter für einen Button dient.
Nun wird an die Objektvariable über die Add - Methode des Commandbarobjektes eine neue Leiste mit dem Namen "Privat" übergeben. Dabei werden außer dem Namen noch folgende Parameter benötigt:
Position:
msoBarFloating - eine frei schwebende Leiste.
msoBarTop - die Leiste wird unter der untersten Leiste angedockt.
msoBarBottom - die Leiste wird über der Statuszeile angedockt.
msoBarLeft - die Leiste wird links angedockt.
msoBarRight - die Leiste wird rechts angedockt.
msoBarPopup - ein Kontextmenü welches z.B. durch einen Rechtsklick in eine Zelle aufgerufen wird.
MenuBar:
False - eine Symbolleiste
True - eine Symbolleiste, welche das Systemmenü der Mappe (minimieren, wiederherstellen und schließen) übernimmt.
Temporary:
Das kennen wir schon aus dem 1. Teil. Da galt es für einen einzelnen Button. Diesmal für die ganze Leiste.
Damit wäre eine zunächst leere Leiste geschaffen, die wir nun mit verschiedenen Steuerelementen bestücken.
Als erstes fügen wir einen anscheinend normalen Button ein. Der aber im Vergleich zu dem Button aus dem 1. Teil eine etwas andere OnAction - Eigenschaft besitzt. Wie sie sehen gibt es zwei Varianten.
Die von dem Button aufgerufenen Makros sehen folgendermaßen aus:
Public Sub prcAction1(ByVal varAction As Variant)
Static bolDo As Boolean
bolDo = Not bolDo
If bolDo Then MsgBox varAction
End Sub
Public Sub prcAction2(ByVal varAction As Variant)
If TypeOf ActiveSheet Is Worksheet Then
If Not ActiveSheet.ProtectContents Or ActiveSheet.ProtectContents _
And Not ActiveCell.Locked Then _
ActiveCell.FormulaR1C1 = "=" & varAction Else _
MsgBox "Die Zelle ist geschützt.", 48, "Hinweis"
Else
Beep
End If
End Sub
Fügen sie diese Makros unter dem bisherigen Code ein.
Die Makros machen zugegeben wenig Sinn. Wir wollen aber die Möglichkeiten, welche das Commandbarbutton - Objekt zur Verfügung stellt ausloten. Makros dieser Art unterliegen den selben Beschränkungen wie benutzerdefinierte Tabellenblattfunktionen. Mit der Ausnahme, der Beschränkung bei Zellen. Die erste Methode ruft das Makro zweimal auf, was wir mit der statischen Variable bolDo abfangen.
Nun folgt ein zweiter Button. Dieser bekommt über die PasteFace - Methode das, sofern vorhanden, zuvor kopierte Bild als Icon. Ansonsten das Icon des Hyperlinks. Auch hier gibt es Varianten.
Dieser Button bekommt in der ersten Variante die HyperlinkType - Eigenschaft msoCommandBarButtonHyperlinkOpen. Die Adresse des Hyperlinks wird in der TooltipText - Eigenschaft angegeben.
Damit können sie wie die auskommentierten Zeilen schon andeuten, nicht nur eine Internetsite öffnen, sondern auch:
Den Maileditor starten (Mit Mailadresse und Betreff)
Wie über einen Hyperlink in einer Tabelle z.B. eine Datei öffen.
In der zweiten Variante bekommt der Button die HyperlinkType - Eigenschaft msoCommandBarButtonHyperlinkInsertPicture. Die TooltipText - Eigenschaft bekommt den Dateinamen einer Bilddatei.
Dieses Bild wird beim Klick auf den Button in die aktive Zelle eingefügt.
Der Button löst kein Makro aus.
Unser drittes Steuerelement ist ein Edit - Control. Dies ist vom Typ eine CommandBarComboBox, in welches Eingaben erfolgen können. Die Eingabe muss, um das Makro zu starten mit Enter abgeschlossen werden. Dazu kommt noch ein normaler Button, welcher das selbe Makro aufruft wie das Edit - Control. In der Caption - Eigenschaft des Buttons sehen sie vor dem W ein & (lateinisches et). Damit weisen wir ihm den Shortcut Alt+w zu. Achten sie darauf, dass sie keinen Shortcut aus den sichtbaren Elementen der Menüleiste verwenden (Die unterstrichenen Buchstaben sind der Shortcut !!!). Wir wollen es dazu benutzen, in der Tabelle eine Suchfunktion zu starten.
Fügen sie folgende Routine unter unserm bisherigen Code ein.
Private Sub prcSearch()
Dim myRange As Range
If Trim$(myCommandBarComboBox(1).Text) <> "" Then
Set myRange = Cells.Find(What:=Trim$(myCommandBarComboBox(1).Text) _
, After:=ActiveCell, LookIn:=xlValues)
If Not myRange Is Nothing Then
myRange.Select
Set myRange = Nothing
Else
MsgBox "Suchbegriff nicht in der aktiven Tabelle.", 48, "Hinweis"
End If
Else
MsgBox "Sie haben keinen Suchbegriff eingegeben.", 48, "Hinweis"
End If
End Sub
Das vierte Element ist ein Popup - Control, welches zwei Buttons und ein weiteres Popup - Control mit einem Button enthält. Das Poup - Control ruft selbst kein Makro auf, obwohl das möglich wäre. Dann würde es aber nicht mehr aufklappen, sondern das Makro ausführen.
Die Buttons sprechen alle das selbe Makro an, lösen aber unterschiedliche Reaktionen hervor, da in dem Makro die Tag - Eigenschaft der Buttons ausgelesen wird. Das geschieht mit Hilfe der ActionControl - Eigenschaft der Commandbars - Auflistung.
Das dazugehörige Makro können sie nun ebenfalls einfügen.
Private Sub prcRamifyTag()
Select Case Application.CommandBars.ActionControl.Tag
Case "1": MsgBox "Button 1"
Case "2": MsgBox "Button 2"
Case "3": MsgBox "Button 3"
End Select
End Sub
Das nun folgende Control ist eine CommandBarComboBox. Sie dient wie andere Comboboxen zum auswählen und eingeben. Da wir es zum schnellen anwählen von Tabellen benutzen wollen, müssen wir das eingeben von Werten abfangen. Außerdem müssen wir es über eine Routine mit den Tabellennamen füllen. Dazu benötigen wir mehrere Makros, welche sie nun einfügen können.
Achtung, das sind aber noch nicht alle, da die Box auf das löschen und hinzufügen von Tabellen reagieren soll. Diese befinden sich, da es sich dabei um Ereignisse der Mappe handelt, in seinem Klassenmodul, welches am Ende des Artikels gezeigt wird.
Public Sub prcAddSheets()
Dim intIndex As Integer
With myCommandBarComboBox(2)
.Clear
For intIndex = 1 To ThisWorkbook.Sheets.Count
.AddItem Text:=ThisWorkbook.Sheets(intIndex).Name
Next
If ThisWorkbook.Sheets.Count < 31 Then .DropDownLines = _
ThisWorkbook.Sheets.Count Else .DropDownLines = 30
End With
Call prcShowName
End Sub
Public Sub prcCheck()
Dim intIndex As Integer
With myCommandBarComboBox(2)
If ThisWorkbook.Sheets.Count = .ListCount Then
For intIndex = 1 To ThisWorkbook.Sheets.Count
If .List(intIndex) <> ThisWorkbook.Sheets(intIndex).Name Then _
Call prcAddSheets: Exit Sub
Next
Call prcShowName
Else
Call prcAddSheets
End If
End With
End Sub
Private Sub prcSelect()
On Error Resume Next
Sheets(myCommandBarComboBox(2).Text).Select
If Err.Number <> 0 Then Call prcCheck
End Sub
Private Sub prcShowName()
myCommandBarComboBox(2).Text = ActiveSheet.Name
End Sub
Unser letztes Element ist ein Dropdown - Control, welches auch aus der Familie der CommandBarComboBox stammt. Dieses Control ist ein reines Auswahlmenü, in das nicht eingegeben werden kann.
Sie könnten nun einwenden, das die doch besser zum auswählen von Tabellen geeignet wäre, da dort ja nichts eingegeben werden kann. Sie haben nicht ganz unrecht. Aber die anzeige des Namens der Tabelle, die über den Tabellenreiter aktiviert wurde ist nur mit einer Schleife möglich, welche den entsprechenden Listindex ermittelt. Da ist die Combobox einfacher zu handhaben. Und mit einer On Error - Anweisung lassen sich Eingaben darin leicht abfangen.
Das Dropdown wollen wir benutzen, um in Zellen Werte einzutragen. Fügen sie nun die beiden letzten Makros in das Modul ein.
Private Sub prcAddItems()
Dim varArray As Variant, varItem As Variant
varArray = Array("Peter", "Max", "Beate", "Nancy")
For Each varItem In varArray
myCommandBarComboBox(3).AddItem Text:=varItem
Next
End Sub
Private Sub prcEnter()
If TypeOf ActiveSheet Is Worksheet Then
If Not ActiveSheet.ProtectContents Or ActiveSheet.ProtectContents _
And Not ActiveCell.Locked Then _
ActiveCell.Value = myCommandBarComboBox(3).Text Else _
MsgBox "Die Zelle ist geschützt.", 48, "Hinweis"
Else
Beep
End If
End Sub
Jetzt soll noch die Leiste an einer bestimmten Stelle erscheinen, welches über die Top - und Left - Eigenschaft bestimmt wird.
Außerdem soll die Leiste einen gewissen Schutz erhalten, was über die Protect - Eigenschaft erreicht wird. Hier gibt es wieder mehrere Konstanten:
msoBarNoChangeDock - Eine angedockte Leiste kann nicht verschoben werden bzw. eine freischwebende Leiste kann nicht angedockt werden.
msoBarNoChangeVisible - Das kleine Schließenkreuz der Leiste wird ausgeblendet. (Über das Menü "Anpassen" ist es aber immer noch möglich)
msoBarNoCustomize - Der Benutzer kann keine Elemente entfernen oder hinzufügen.
msoBarNoHorizontalDock - Die Leiste kann, wenn überhaupt, nur Vertikal angedockt werden.
msoBarNoVerticalDock - Die Leiste kann, wenn überhaupt, nur Horizontal angedockt werden.
msoBarNoMove - Die Leiste wird fixiert.
msoBarNoResize - Das Seiten- Höhenverhältnis ist fixiert.
msoBarNoProtection - Jeglicher Schutz ist aufgehoben.
Über die Visible - Eigenschaft muss die Leiste nur noch eingeblendet werden.
Nun noch die Ereignisroutinen der Mappe in das Klassenmodul diese Arbeitsmappe, um die Leiste zu erzeugen, zu löschen, sowie ein- und auszublenden. Zusätzlich die Routinen, welche auf das wechseln der Tabellen per Klick auf den Tabellenreiter und das löschen bzw. einfügen von Tabellen reagiert, und schon sind wir fertig.
Option Explicit
Private Sub Workbook_Activate()
If Not myCommandBar Is Nothing Then myCommandBar.Visible = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Änderungen speichern?", 35, "Abfrage")
Case 2
Cancel = True
Exit Sub
Case 6: .Save
Case 7: .Saved = True
End Select
End If
End With
Call prcDeleteCommandBar
End Sub
Private Sub Workbook_Deactivate()
If Not myCommandBar Is Nothing Then myCommandBar.Visible = False
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Not myCommandBar Is Nothing Then Call prcAddSheets
End Sub
Private Sub Workbook_Open()
Call prcCreateCommandBar
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not myCommandBar Is Nothing Then Call prcCheck
End Sub
Jetzt können sie das Makro prcCreateCommandBar() starten.
Teil 2 der Symbolleistentrilogie war schon ein bisschen schwieriger, aber keine Angst, es ist noch steigerungsfähig.
Weitere Artikel der Gruppe: Tutorials Aus Excel VBA
Nach oben