Autor: Max Kaffl (Nepumuk)  --- Aus Excel VBA - Gruppe: Tutorials

Symbolleisten (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
ToDo
Google Werbung