HERBERS Excel-Forum - VBA-Basics

Thema: Menü- und Symbolleisten

Inhaltsverzeichnis
  • 1 Grundsätzliches
  • 2 Beispiele für das VBA-Handling von CommandBars
  • 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 4 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 angegliert)
      • 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. bereit 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 estistiert
      • 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
         End
      ERRORHANDLER:
      End Sub
      

    Alle Menüleiste 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) = 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.

    • 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
      • Einen With-Rahmen um das Objekt bilden
      • 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
         With FSO
            Set oFolder = .GetFolder(.GetFolder(.GetParentFolderName( _
               Application.UserLibraryPath)).Path & "\Excel")
         End With
         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