VBA in Excel/ Menü- und Symbolleisten

Aus Wikibooks
Wechseln zu: Navigation, Suche
| One wikibook.svg Hoch zu „Inhaltsverzeichnis“ |


Grundsätzliches[Bearbeiten]

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[Bearbeiten]

    Menüleiste ein-/ausblenden[Bearbeiten]

    • 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[Bearbeiten]

    • 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[Bearbeiten]

    • 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[Bearbeiten]

    • 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[Bearbeiten]

    • 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[Bearbeiten]

    • Prozedur: Worksheet_Activate
    • Art: Ereignis
    • Modul: Klassenmodul des Arbeitsblattes Dummy
    • Zweck: Jahreskalender-Symbolleiste erstelllen
    • 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[Bearbeiten]

    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[Bearbeiten]

    • 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