VBA in Excel/ Menü- und Symbolleisten

| Hoch zu „Inhaltsverzeichnis“ |

Grundsätzliches

Menü- und Symbolleisten sind sowohl manuell wie auch über VBA zu erstellen, zu verändern und zu löschen.

Seit der Excel-Version 8.0 (Office 97) handelt es sich bei den Menü- und Symbolleisten um das Objektmodell der Commandbars mit den zugehörigen Control-Elementen CommandBarButton, CommandBarPopUp und CommandBarComboBox unter dem Oberbegriff CommandBarControl.

Grundsätzlich empfiehlt es sich, zu einer Arbeitsmappe gehörende CommandBars oder CommandBarControls beim Öffnen der Arbeitsmappe über das Workbook_Open-Ereignis zu erstellen und über das Workbook_BeforeClose-Ereignis zu löschen. Nur so ist gewährleistet, dass der Anwender nicht durch Auswirkungen von CommandBar-Programmierungen oder -Anbindungen belästigt wird.

Der Commandbars-Auflistung fügt man mit der Add-Methode eine neue Leiste hinzu. Erfolgt die Erstellung der neuen CommandBar in einem Klassenmodul, ist die Syntax Application.CommandBars.Add... zwingend erforderlich, erfolgt die Erstellung in einem Standardmodul, reicht ein CommandBars.Add.... Um später mögliche Kollisionen mit anderen Office-Anwendungen zu vermeiden, wird allerdings auch hier die Application-Nennung empfohlen.

Die Add-Methode kann mit bis zu 9 Parameter aufgerufen werden:

• Name
  Der Name der Symbolleiste, zwingend erforderlich
• Position
  optional, folgende Konstanten sind möglich:
  • msoBarLeft (am linken Bildschirmrand)
  • msoBarRight (am rechten Bildschirmrand)
  • msoBarTop (wird an die bestehenden Symbolleisten angegliedert)
  • msoBarBottom (am unteren Bildschirmrand, über der Statusleiste)
  • msoBarFloating (nicht verankerte Symbolleiste, die Position kann festgelegt werden)
  • msoBarPopUp (Kontext-Symbolleiste, mit der rechten Maustaste im Tabellenblatt aufrufbar)
• MenuBar
  optional, legt fest, ob es sich um eine Menü- oder eine Symbolleiste handelt (TRUE = Menüleiste, FALSE = Symbolleiste, Voreinstellung ist FALSE).
• Temporary
  optional, legt fest, ob die Menü- oder Symbolleiste mit Microsoft Excel geschlossen werden soll (TRUE = temporär, FALSE = bestehenbleibend, Voreinstellung ist FALSE). Wird also TRUE festgelegt, wird die CommandBar gelöscht, wenn Excel geschlossen wird und taucht auch in der CommandBar-Auflistung nicht mehr auf.

Beispiele für das VBA-Handling von CommandBars

Menüleiste ein-/ausblenden

• Prozedur: CmdBarEinAus
• Art: Sub
• Modul: Standardmodul
• Zweck: Arbeitsblattmenüleiste aus- und einblenden.
• Ablaufbeschreibung:
  • Rahmen mit dem CommandBar-Objekt bilden
  • Wenn eingeschaltet ausschalten, sonst einschalten
• Code:

Sub CmdBarEinAus()
   With Application.CommandBars("Worksheet Menu Bar")
      .Enabled = Not .Enabled
   End With
End Sub

Neue Menüleiste erstellen und einblenden

• Prozedur: NewMenueBar
• Art: Sub
• Modul: Standardmodul
• Zweck: Es wird eine neue Menüleiste erstellt und eingeblendet, wobei die Arbeitsblattmenüleiste ausgeblendet wird.
• Ablaufbeschreibung:
  • Variablendeklaration
  • Prozedur zum Löschen der evtl. bereits bestehenden Menüleiste aufrufen
  • Menüleiste erstellen
  • 1. Menü erstellen
  • Schleife über 12 Monate bilden
  • Monatsschaltfläche erstellen
  • Rahmen um das Schaltflächenobjekt erstellen
  • Aufschriftung festlegen
  • Der Schaltfläche keine Prozedur zuweisen
  • Den Aufschrifttyp festlegen
  • 2. Menü erstellen
  • Schleife über 12 Monate bilden
  • Monatsschaltfläche erstellen
  • Rahmen um das Schaltflächenobjekt erstellen
  • Aufschriftung festlegen
  • Der Schaltfläche keine Prozedur zuweisen
  • Den Aufschrifttyp festlegen
  • Arbeitsblattmenüleiste ausblenden
  • Neue Menüleiste einblenden
• Code:

Sub NewMenueBar()
   Dim oCmdBar As CommandBar
   Dim oPopUp As CommandBarPopup
   Dim oCmdBtn As CommandBarButton
   Dim datDay As Date
   Dim iMonths As Integer
   Call DeleteNewMenueBar
   Set oCmdBar = Application.CommandBars.Add( _
      Name:="MyNewCommandBar", _
      Position:=msoBarTop, _
      MenuBar:=True, _
      temporary:=True)
   Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
   oPopUp.Caption = "Prüfung"
   For iMonths = 1 To 12
      Set oCmdBtn = oPopUp.Controls.Add
      With oCmdBtn
         .Caption = Format(DateSerial(1, iMonths, 1), "mmmm") & " Druck"
         .OnAction = ""
         .Style = msoButtonCaption
      End With
   Next iMonths
   Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
   oPopUp.Caption = "Monatsbericht"
   For iMonths = 1 To 12
      Set oCmdBtn = oPopUp.Controls.Add
      With oCmdBtn
         .Caption = Format(DateSerial(1, iMonths, 1), "mmmm") & " Druck"
         .OnAction = ""
         .Style = msoButtonCaption
      End With
   Next iMonths
   Application.CommandBars("Worksheet Menu Bar").Enabled = False
   oCmdBar.Visible = True
End Sub

• Prozedur: DeleteNewMenueBar
• Art: Sub
• Modul: Standardmodul
• Zweck: Evtl. bestehende Menüleiste löschen
• Ablaufbeschreibung:
  • Fehlerroutine für den Fall starten, dass die Menüleiste nicht existiert
  • Benutzerdefinierte Menüleiste löschen
  • Arbeitsblattmenüleiste einblenden
• Code:

Private Sub DeleteNewMenueBar()
   On Error GoTo ERRORHANDLER
   Application.CommandBars("MyNewCommandBar").Delete
   Application.CommandBars("Worksheet Menu Bar").Enabled = True 
   Exit Sub
ERRORHANDLER:
End Sub

Alle Menüleisten ein-/ausblenden

• Prozedur: AllesAusEinBlenden
• Art: Sub
• Modul: Standardmodul
• Zweck: Alle Menü- und Symbolleisten aus- und einblenden.
• Ablaufbeschreibung:
  • Objektvariable für CommandBar erstellen
  • Rahmen um das CommandBar-Objekt erstellen
  • Wenn die Arbeitsblattmenüleiste eingeblendet ist...
  • Arbeitsblattmenüleiste ausblenden
  • Auf Vollbildschirm schalten
  • Eine Schleife über die CommandBars bilden
  • Wenn es sich bei der aktuellen CommandBar nicht um die Arbeitsblattmenüleiste handelt...
  • Wenn die aktuelle CommandBar sichtbar ist...
  • Die aktuelle Commandbar ausblenden
  • Aktive Arbeitsmappe schützen, wobei der Windows-Parameter auf True gesetzt wird (hierdurch werden die Anwendungs- und Arbeitsmappen-Schließkreuze ausgeblendet)
  • Wenn die Arbeitsblattmenüleiste nicht sichtbar ist...
  • Arbeitsmappenschutz aufheben
  • Arbeitsblattmenüleiste anzeigen
  • Vollbildmodus ausschalten
• Code:

Sub AllesAusEinBlenden()
   Dim oBar As CommandBar
   With CommandBars("Worksheet Menu Bar")
      If .Enabled Then
         .Enabled = False
         Application.DisplayFullScreen = True
         For Each oBar In Application.CommandBars
            If oBar.Name <> "Worksheet Menu Bar" Then
               If oBar.Visible Then
                  oBar.Visible = False
               End If
            End If
         Next oBar
         ActiveWorkbook.Protect Windows:=True
      Else
         ActiveWorkbook.Unprotect
         .Enabled = True
         Application.DisplayFullScreen = False
      End If
   End With
End Sub

Jahreskalender als Symbolleiste erstellen bzw. löschen

• Prozedur: NewCalendar
• Art: Sub
• Modul: Standardmodul
• Zweck: Jahreskalender als Symbolleiste anlegen
• Ablaufbeschreibung:
  • Variablendeklaration
  • Fehlerroutine einschalten
  • Jahreskalender-Symbolleiste löschen
  • Prozedur beenden
  • Wenn keine Jahreskalender-Symbolleiste vorhanden war...
  • Neue Symbolleiste erstellen
  • Schleife über 12 Monate bilden
  • Menü für jeden Monat anlegen
  • Menüaufschrift festlegen
  • Wenn der Monatszähler durch 4 teilbar ist, eine neue Gruppe beginnen
  • Die Tagesanzahl des jeweiligen Monats ermitteln
  • Eine Schleife über die Tage des jeweiligen Monats bilden
  • Das jeweilig aktuelle Datum ermitteln
  • Tagesschaltfläche erstellen
  • Aufschrift der Tagesschaltfläche festlegen
  • Aufschriftart der Tagesschaltfläche festlegen
  • Aufzurufende Prozedur festlegen
  • Wenn es sich um einen Montag handelt, eine neue Gruppe beginnen
  • Neue Symbolleiste anzeigen
• Code:

Sub NewCalendar()
   Dim oCmdBar As CommandBar
   Dim oPopUp As CommandBarPopup
   Dim oCmdBtn As CommandBarButton
   Dim datDay As Date
   Dim iMonths As Integer, iDays As Integer, iCount As Integer
   On Error GoTo ERRORHANDLER
   Application.CommandBars(CStr(Year(Date))).Delete
   Exit Sub
ERRORHANDLER:
   Set oCmdBar = Application.CommandBars.Add( _
      CStr(Year(Date)), msoBarTop, False, True)
   For iMonths = 1 To 12
      Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
      With oPopUp
         .Caption = Format(DateSerial(1, iMonths, 1), "mmmm")
         If iMonths Mod 3 = 1 And iMonths <> 1 Then .BeginGroup = True
         iCount = Day(DateSerial(Year(Date), iMonths + 1, 0))
         For iDays = 1 To iCount
            datDay = DateSerial(Year(Date), iMonths, iDays)
            Set oCmdBtn = oPopUp.Controls.Add
            With oCmdBtn
               .Caption = Day(datDay) & " - " & Format(datDay, "dddd")
               .Style = msoButtonCaption
               .OnAction = "GetDate"
               If Weekday(datDay, vbUseSystemDayOfWeek) = 1 And iDays <> 1 Then .BeginGroup = True
            End With
         Next iDays
      End With
   Next iMonths
   oCmdBar.Visible = True
End Sub




• Prozedur: GetDate
• Art: Sub
• Modul: Standardmodul
• Zweck: Das aufgerufene Tagesdatum melden
• Ablaufbeschreibung:
  • Variablendeklaration
  • Aktuelles Jahr ermitteln
  • Monat ermitteln, aus dem der Aufruf erfolgte
  • Tag ermitteln, der ausgewählt wurde
  • Ausgewähltes Datum melden
• Code:

Sub GetDate()
   Dim iYear As Integer, iMonth As Integer, iDay As Integer
   Dim iGroupM As Integer, iGroupD As Integer
   iYear = Year(Date)
   iMonth = WorksheetFunction.RoundUp(Application.Caller(2) - _
      (Application.Caller(2) / 4), 0)
   iDay = Application.Caller(1) - GetGroups(iMonth, Application.Caller(1))
   MsgBox Format(DateSerial(iYear, iMonth, iDay), "dddd - dd. mmmm yyyy")
End Sub

• Prozedur: GetGroups
• Art: Function
• Modul: Standardmodul
• Zweck: Gruppe auslesen
• Ablaufbeschreibung:
  • Variablendeklaration
  • Zählvariable initialisieren
  • Eine Schleife über alle Monate der Jahreskalender-Symbolleiste bilden
  • Solange die Zählvariable kleiner/gleich die Anzahl der Controls...
  • Wenn eine neue Gruppe beginnt...
  • Gruppenzähler um 1 hochzählen
  • Wenn die Zählvariable gleich dem übergebenen Tag minus dem Gruppenzähler, dann Schleife beenden
  • Zählvariable um 1 hochzählen
  • Gruppenzähler als Funktionswert übergeben
• Code:

Private Function GetGroups(iActMonth As Integer, iActDay As Integer)
   Dim iGroups As Integer, iCounter As Integer
   iCounter = 1
   With Application.CommandBars(CStr(Year(Date))).Controls(iActMonth)
      Do While iCounter <= .Controls.Count
         If .Controls(iCounter).BeginGroup = True Then
            iGroups = iGroups + 1
         End If
         If iCounter = iActDay - iGroups Then Exit Do
         iCounter = iCounter + 1
      Loop
      GetGroups = iGroups
   End With
End Function

Alle Menü- und Symbolleisten auflisten

• Prozedur: ListAllCommandbars
• Art: Sub
• Modul: Standardmodul
• Zweck: Alle Symbolleisten mit dem englischen und dem Landesnamen mit der Angabe, ob sichtbar oder nicht, auflisten
• Ablaufbeschreibung:
  • Variablendeklaration
  • Bildschirmaktualisierung ausschalten
  • Neue Arbeitsmappe anlegen
  • Kopfzeile schreiben
  • Kopfzeile formatieren
  • Zeilenzähler initialisieren
  • Eine Schleife über alle - eingebauten und benutzerdefinierten - CommandBars bilden
  • Den englischen Namen eintragen
  • Den Landesnamen eintragen
  • Den Sichtbarkeitsstatus eintragen
  • Spaltenbreiten automatisch anpassen
  • Nicht genutzte Spalten ausblenden
  • Nicht genutzte Zeilen ausblenden
  • Bildschirmaktualisierung einschalten
  • Speichernstatus der Arbeitsmappe auf WAHR setzen (um beim Schließen eine Speichern-Rückfrage zu übergehen)
• Code:

Sub ListAllCommandbars()
   Dim oBar As CommandBar
   Dim iRow As Integer
   Application.ScreenUpdating = False
   Workbooks.Add 1
   Cells(1, 1) = "Name"
   Cells(1, 2) = "Lokaler Name"
   Cells(1, 3) = "Sichtbar"
   With Range("A1:C1")
      .Font.Bold = True
      .Font.ColorIndex = 2
      .Interior.ColorIndex = 1
   End With
   iRow = 1
   For Each oBar In Application.CommandBars
      iRow = iRow + 1
      Cells(iRow, 1) = oBar.Name
      Cells(iRow, 2) = oBar.NameLocal
      Cells(iRow, 3) = oBar.Visible
    Next oBar
    Columns("A:C").AutoFit
    Columns("D:IV").Hidden = True
    Rows(iRow + 1 & ":" & Rows.Count).Hidden = True
    Application.ScreenUpdating = True
    ActiveWorkbook.Saved = True
End Sub

Jahreskalender bei Blattwechsel anlegen bzw. löschen

• Prozedur: Worksheet_Activate
• Art: Ereignis
• Modul: Klassenmodul des Arbeitsblattes Dummy
• Zweck: Jahreskalender-Symbolleiste erstellen
• Ablaufbeschreibung:
  • Aufruf der Prozedur zur Erstellung bzw. dem Löschen des Kalenders
• Code:

Private Sub Worksheet_Activate()
   Call NewCalendar
End Sub

• Prozedur: Worksheet_Deactivate
• Art: Ereignis
• Modul: Klassenmodul des Arbeitsblattes Dummy
• Zweck: Jahreskalender-Symbolleiste erstellen
• Ablaufbeschreibung:
  • Aufruf der Prozedur zur Erstellung bzw. dem Löschen des Kalenders
• Code:

Private Sub Worksheet_Deactivate()
   Call NewCalendar
End Sub

Dateinamen der *.xlb-Datei ermitteln

Die Informationen über die CommandBars werden in einer .xlb-Datei mit je nach Excel-Version wechselndem Namen im Pfad der Anwenderbibliotheken im Excel-Verzeichnis abgelegt. Die nachfolgenden Routinen ermitteln den Namen und das Änderungs-Datum dieser Datei. Der Code ist nur ab XL9 (Office 2000) lauffähig, da die Application.UserLibraryPath- Eigenschaft bei der Vorgängerversion noch nicht implementiert war. Der folgende Code nutzt das Scripting.FileSystemObject aus der Scripting-Klasse und setzt deshalb einen Verweis auf die "Microsoft Scripting Runtime"-Library voraus. Der Verweis kann im Makroeditor unter Extras > Verweise gesetzt werden. Ohne diesen Verweis compiliert das Programm mit einem Fehler.

• Prozedur: GetXLBName
• Art: Sub
• Modul: Standardmodul
• Zweck: Name der XLB-Datei melden
• Ablaufbeschreibung:
  • Variablendeklaration
  • Funktion zur Ermittlung des Dateinamens aufrufen
  • Wenn ein Leerstring zurückgegeben wurde...
  • Negativmeldung
  • Sonst...
  • Meldung des Dateinamens
• Code:

Sub GetXLBName()
   Dim sFile As String
   sFile = FindFile(0)
   If sFile = "" Then
      MsgBox "Die *.xlb-Datei wurde nicht gefunden!"
   Else
      MsgBox "Name der *.xlb-Datei: " & vbLf & sFile
   End If
End Sub

• Prozedur: FindFile
• Art: Sub
• Modul: Standardmodul
• Zweck: Name und Änderungsdatum der XLB-Datei ermitteln
• Ablaufbeschreibung:
  • Variablendeklaration
  • Excel-Version ermitteln
  • Wenn es sich um die Version 8.0 handelt...
  • Negativmeldung und Prozedurende
  • Ein Sripting.FileSystemObject erstellen
  • Den Ordner oberhalb des Anwenderbibliothekspfads ermitteln und um den Begriff \Excel erweitern
  • Eine Schleife über alle Dateien des ermittelten Ordners bilden
  • Wenn die Datei die Suffix .xlb beinhaltet...
  • Wenn das Änderungsdatum nach dem zuletzt ermittelten Änderungsdatum liegt...
  • Änderungsdatum der aktuellen Datei in eine Datums-Variable einlesen
  • Dateinamen in String-Variable einlesen
  • Dateiname und Änderungsdatum in eine Variant-Variable einlesen
  • Die Variant-Variable an die Funktion übergeben
• Code:
  
  

Private Function FindFile() As Variant
   Dim FSO As Scripting.FileSystemObject
   Dim oFile As Scripting.File
   Dim oFolder As Scripting.Folder
   Dim arrFile As Variant
   Dim datFile As Date
   Dim sFile As String, sVersion As String
   sVersion = Left(Application.Version, 1)
   If sVersion = "8" Then
      Beep
      MsgBox "Nur ab Version 9.0 möglich!"
      End
   End If
   Set FSO = New Scripting.FileSystemObject
   Set oFolder = FSO.GetFolder(FSO.GetParentFolderName(Application.UserLibraryPath) & "\Excel")
   For Each oFile In oFolder.Files
      If Right(oFile.Name, 4) = ".xlb" Then
         If datFile < oFile.DateLastAccessed Then
            datFile = oFile.DateLastAccessed
            sFile = oFile.Path
         End If
      End If
   Next oFile
   arrFile = Array(sFile, datFile)
   FindFile = arrFile
End Function

Dateiänderungsdatum der *.xlb-Datei ermitteln

• Prozedur: GetXLBDate
• Art: Sub
• Modul: Standardmodul
• Zweck: Dateiänderungsdatum der XLB-Datei melden
• Ablaufbeschreibung:
  • Variablendeklaration
  • Funktion zur Ermittlung des Dateidatums aufrufen
  • Wenn ein Nullwert zurückgegeben wurde...
  • Negativmeldung
  • Sonst...
  • Meldung des Dateiänderungsdatums
• Code:

Sub GetXLBDate()
   Dim datFile As Date
   datFile = FindFile(1)
   If datFile = 0 Then
      MsgBox "Die *.xlb-Datei wurde nicht gefunden!"
   Else
      MsgBox "Letztes Änderungsdatum der *.xlb-Datei: " & vbLf & datFile
   End If
End Sub




| Hoch zu „Inhaltsverzeichnis“ |