Zurück zur Homepage

Menü in Userform #2

In einem anderen Beispiel habe ich bereits schon einmal gezeigt, wie man Userformen mit Menüs ausstattet. Dieses Beispiel war in der Handhabung aber doch recht kompliziert, der Code selber dagegen verhältnismäßig kurz. Aufgrund einer Nachfrage habe ich mich noch einmal damit beschäftigt und die Arbeitsmappe etwas aufgepeppt.

Verbessert wurde vor Allem die Handhabung. So ist es nun möglich, durch das Verwenden von Pfaden ein komplettes Menü inklusive allen zugehörigen Submenüs zu erzeugen. Auch die Angabe einer ID ist möglich, es kann beim Anlegen dazu noch optional festgelegt werden, ob ein Menüpunkt ausgegraut, abgehakt, oder gar als Trennzeile dargestellt wird. Das Kaufmännische UND (&) vor einem Buchstaben legt in einem Menü den unterstrichenen Buchstaben fest, über den man zusammen mit der Alt-Taste den entsprechenden Punkt auswählen kann.

AddMenuVBA MenuPath:="&Datei\öf&fnen\&File\&False", ID:=21230, Grayed:=True

Die vorherige Zeile legt auf oberster Ebene den Menüpunkt Datei an, als Submenü den Punkt öffnen, darunter das Submenü File und schließlich ausgegraut den Menüpunkt False. Möglich sind prinzipiell beliebig viele Pfade, bereits vorhandene Menüs werden dabei beibehalten.

Folgende Zeile unterscheidet sich lediglich im letzten Menüpunkt, im Submenü File wird also ein neuer Menüpunkt ccc angelegt, der abgehakt wird.

AddMenuVBA MenuPath:="&Datei\öf&fnen\&File\c&cc", ID:=21230, Checked:=True

menu

Abbildung 1

Außerdem kann man während der Laufzeit die Eigenschaften eines Menüpunktes ändern. Es kann beispielsweise der Text geändert, ein Menüpunkt ausgegraut oder aktiviert und schließlich noch ein Haken gesetzt oder entfernt werden.

Wo viel Licht ist, gibt es natürlich auch Schatten. So ist der Code doch recht umfangreich, und um überhaupt auf Menüereignisse reagieren zu können, müssen Fensternachrichten an eigene Funktionen umgeleitet werden. Dazu wird hier Subclassing eingesetzt, ich hatte zwar auch mal mit Hooks getestet, um die Anzahl der Aufrufe zu minimieren, befriedigt hatte mich das aber auch nicht.

Es muss dazugesagt werden, dass beim Subclassing das Anzeigen einer ungebundenen (vbModeless) Userform unweigerlich zum Einfrieren der Anwendung, später zum Absturz führt, Auch das Setzen eines Hooks ändert nichts an diesem unerfreulichen Umstand. In unempfindlichen Hook-Modi, beispielsweise WH_CBT können die relevanten Nachrichten leider nicht empfangen werden, in empfindlichen (WH_MSGFILTER) kommen zwar die richtigen Nachrichten an, aber da Threadweit abgehört wird, müssen auch noch die Nachrichten des entsprechenden Fensters erkannt werden.

Die Userform darf keinesfalls ungebunden (vbModeless) aufgerufen werden. In der Prozedur, welche die Fensternachrichten empfängt, darf außerdem kein Haltepunkt gesetzt werden. Eine Fehlerbehandlung ist unumgänglich, es muss immer sichergestellt werden, dass mit der API CallWindowProc die empfangenen Nachrichten auch unverzüglich weitergeleitet werden. Besonders tückisch sind Syntaxfehler, falsche Parameterübergaben an aufgerufene Prozeduren oder nicht deklarierte Variablen, die normalerweise den Debugger auf den Plan rufen würden. In diesem Fall ist ein sofortiger Absturz gewiss, ohne dass man dabei auf den Fehler hingewiesen wird. Das gleiche gilt auch für alle aufgerufen Funktionen oder Prozeduren. Man testet also am besten vor dem Scharfschalten die aufgerufenen Prozeduren/Funktionen mittels Testprozeduren.

Leider sind Callbackfunktionen, zu denen auch die angesprochene Funktion gehört, nur in normalen Modulen möglich. Das ist schade, denn andernfalls wäre es möglich, den gesamten Code in eine Klasse auslagern, zu denen ja auch eine Userform gehört. Man könnte zwar in einer Klasse (Objekt), in der generell Com-Regeln gelten, über Pointer zur VTable den Stapel (Stack) so manipulieren, dass ein eingeschleustes Assemblerprogramm die Argumente und Funktionsergebnisse dahin transportieren, wo sie hinsollen. Mir ist es aber bisher lediglich gelungen, eine Prozedur, genauer gesagt eine API-Timerprozedur in einer Klasse zu realisieren.

Dagegen scheitert ein Auslagern des gesamten Codes in ein normales Modul daran, dass bei einem modalen Aufruf einer Userform die aufrufende Prozedur an dieser Stelle angehalten wird, das Setzen eines Hooks oder das Umleiten der Fensternachrichten somit nicht stattfinden. Der Code verteilt sich demnach immer auf das Klassenmodul der Userform und ein normales Modul.

Hat man sich an diese paar Regeln gehalten, kann man aber problemlos und stabil mit Menüs arbeiten. Letztendlich entscheidet aber jeder selber, ob er Menüs überhaupt einsetzen möchte.

 

Auch bei diesem Beispiel gilt, dass man den Code frei benutzen kann. Eine Veröffentlichung des Codes oder Teilen davon, womöglich noch unter anderem Namen, sollte aber unterbleiben.

Excel-Dateien zum Download ca. 89 KB: MenuUserform.xls oder MenuUserform.xlsm

Das Modul mdlMenu

In diesem Modul findet man lediglich die Deklaration einer API-Funktion und die bereits erwähnte Callbackfunktion mit dem Namen NewCallback. Fensternachrichten werden an diese Funktion umgeleitet, wo sie ausgewertet, manipuliert oder auch gelöscht werden können.

Stößt man auf die Menünachricht WM_COMMAND, wird die im Parameter wParam steckende Menü-ID an die Prozedur MenuEvent der Userform weitergeleitet, wo man über die weitere Programmausführung bestimmt.

Alle Nachrichten, die man nicht manipulieren möchte, muss man unverzüglich an den eigentlichen Empfänger weiterleiten. Dazu dient die API-Funktion CallWindowProc. Diese benötigt auch noch das Handle des eigentlichen Empfängers, welche in der öffentlichen Variablen mlngOldWindowProc steckt.

Option Explicit
Private Declare Function CallWindowProc _
   Lib "user32" Alias "CallWindowProcA" ( _
   ByVal lpPrevWndFunc As Long, _
   ByVal hwnd As Long, _
   ByVal MSG As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long _
   ) As Long
   
Public mlngOldWindowProc         As Long

Public Function NewCallback( _
   ByVal hwnd As LongByVal MSG As Long, _
   ByVal wParam As LongByVal lParam As Long _
   ) As Long
   Const WM_COMMAND         As Long = &H111
   On Error Goto Fehlerbehandlung
   
   If MSG = WM_COMMAND Then
      If lParam = 0 Then
         ufMenu.MenuEvent wParam
      End If
   End If
Fehlerbehandlung:
   NewCallback = CallWindowProc( _
      mlngOldWindowProc, hwnd, MSG, wParam, lParam)
End Function
Listing 1

Das Klassenmodul der Userform ufMenu

In dieser UserForm wird ein Menü erzeugt, anschließend mit der UserForm verbunden und danach werden die Fensternachrichten umgeleitet, um auf eine Menüaktivierung zu reagieren. Einen großen Teil des Codes am Anfang des Moduls machen die Deklarationen der benötigten API-Funktionen, der verwendeten Konstanten und der benutzerdefinierten Typen aus.

Die zwei Prozeduren CommandButton1_Click und CommandButton2_Click dienen lediglich zur Demonstration und werden über das Menü aufgerufen.

Option Explicit
Private Type MENUITEMINFO
   cbSize As Long
   fMask As Long
   fType As Long
   fState As Long
   wID As Long
   hSubMenu As Long
   hbmpChecked As Long
   hbmpUnchecked As Long
   dwItemData As Long
   dwTypeData As String
   cch As Long
End Type
Private Declare Function FindWindow _
   Lib "user32" Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String _
   ) As Long
Private Declare Function EnableWindow _
   Lib "user32" ( _
   ByVal hwnd As Long, _
   ByVal fEnable As Long _
   ) As Long
Private Declare Function SetWindowLong _
    Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
    ) As Long
Private Declare Function CreatePopupMenu _
   Lib "user32" () As Long
Private Declare Function CreateMenu _
   Lib "user32" () As Long
Private Declare Function DestroyMenu _
   Lib "user32" ( _
   ByVal glngMenu As Long _
   ) As Long
Private Declare Function DrawMenuBar _
   Lib "user32" ( _
   ByVal hwnd As Long _
   ) As Long
Private Declare Function SetMenu _
   Lib "user32" ( _
   ByVal hwnd As Long, _
   ByVal glngMenu As Long _
   ) As Long
Private Declare Function InsertMenuItem _
   Lib "user32" Alias "InsertMenuItemA" ( _
   ByVal hMenu As Long, _
   ByVal un As Long, _
   ByVal bool As Long, _
   lpcMenuItemInfo As MENUITEMINFO _
   ) As Long
Private Declare Function GetMenuItemInfo _
   Lib "user32" Alias "GetMenuItemInfoA" ( _
   ByVal hMenu As Long, _
   ByVal un As LongByVal b As Long, _
   lpmii As MENUITEMINFO _
   ) As Long
Private Declare Function SetMenuItemInfo _
   Lib "user32" Alias "SetMenuItemInfoA" ( _
   ByVal hMenu As Long, _
   ByVal uItem As LongByVal fByPosition As Long, _
   lpmii As MENUITEMINFO _
   ) As Long
Private Declare Function GetMenu _
   Lib "user32.dll" ( _
   ByVal hwnd As Long _
   ) As Long

Private Const MF_CHECKED         As Long = &H8&
Private Const MF_APPEND          As Long = &H100&
Private Const MF_GRAYED          As Long = &H1&
Private Const MF_SEPARATOR       As Long = &H800&
Private Const MF_STRING          As Long = &H0&

Private Const MIIM_STATE         As Long = &H1&
Private Const MIIM_ID            As Long = &H2&
Private Const MIIM_TYPE          As Long = &H10
Private Const MIIM_SUBMENU       As Long = &H4
Private Const MIIM_CHECKMARKS    As Long = &H8

Private Const GWL_WNDPROC        As Long = (-4)

Private mlngWindow               As Long
Private mlngMainMenu             As Long
Private mcolMenu                 As New Collection

Public Sub CommandButton1_Click()
   MsgBox "Command1"
End Sub

Public Sub CommandButton2_Click()
   MsgBox "Command2"
End Sub

Private Sub UserForm_Initialize()
   ' Menüpunkte in Collection speichern
   AddMenuVBA MenuPath:="&Datei\&Beenden\Aus&führen", _
      ID:=11110
   AddMenuVBA MenuPath:="Bea&rbeiten\&Kopieren\Lo&s", _
      ID:=21100
   AddMenuVBA MenuPath:="Datei\öf&fnen\&File\&False", _
      ID:=21230, Grayed:=True
   AddMenuVBA MenuPath:="Datei\öffnen\&File\-", _
      Separator:=True
   AddMenuVBA MenuPath:="Datei\öffnen\&File\aaa &Aktivieren/Deaktivieren", _
      ID:=11220
   AddMenuVBA MenuPath:="Datei\öffnen\&File\c&cc", _
      ID:=11210
   AddMenuVBA MenuPath:="?", ID:=31110
   
   ' Menü erzeugen
   CreateFormMenu

End Sub

Public Sub MenuEvent(ID As Long)
   On Error Resume Next
   Select Case ID
      Case Is = 11110
         CallByName Me, "CommandButton1_Click", VbMethod
      Case Is = 21100 ' Los
         CommandButton2_Click
      Case Is = 11220 ' aaa &Aktivieren/Deaktivieren
         ChangeMenuItem 21230, InvertGrayed:=CLng(True)
      Case Is = 21230 ' aaa
         ChangeMenuItem 21230, Checked:=CLng(True), MenuText:="True"
         MsgBox "'aaa' gewählt"
      Case Is = 11210 ' ccc
         ChangeMenuItem 11210, InvertChecked:=CLng(True)
      Case Is = 31110 ' ?
         MsgBox "'Help' gewählt"
   End Select
End Sub

Private Sub ChangeMenuItem(ID As Long, _
   Optional Checked As Long = 100, _
   Optional InvertChecked As Long = 100, _
   Optional Grayed As Long = 100, _
   Optional InvertGrayed As Long = 100, _
   Optional MenuText As String)
   
   Dim udtMenu       As MENUITEMINFO
   Dim lngRet        As Long
   Dim blnChecked    As Boolean
   Dim blnGrayed     As Boolean
   
   On Error Resume Next
   
   With udtMenu
      .fMask = MIIM_TYPE Or MIIM_CHECKMARKS Or MIIM_STATE Or MIIM_ID
      .dwTypeData = Space(2048)
      .cch = Len(.dwTypeData)
      .cbSize = Len(udtMenu)
   End With
   
   ' Aktuellen Status des Menüpunktes holen
   lngRet = GetMenuItemInfo(GetMenu(mlngWindow), ID, 0&, udtMenu)
   
   If lngRet = 0 Then Exit Sub
   
   With udtMenu
   
      If MenuText <> "" Then
         ' Neuen Text setzen
         .dwTypeData = MenuText
         .fType = MF_STRING
      End If
   
      ' Status Ausgrauen, Abhaken ermitteln
      blnChecked = .fState And MF_CHECKED
      blnGrayed = .fState And MF_GRAYED
      
      ' Menüpunkt abhaken, oder aufheben
      If Abs(InvertChecked) = 1 Then
         ' Status umkehren
         If blnChecked Then
            .fState = .fState And (Not MF_CHECKED)
         Else
            .fState = .fState Or MF_CHECKED
         End If
      ElseIf Abs(Checked) = 0 Then
         ' Haken entfernen
         .fState = .fState And Not MF_CHECKED
      ElseIf Abs(Checked) = 1 Then
         ' Hakem setzen
         .fState = .fState Or MF_CHECKED
      End If
      
      ' Menüpunkt ausgrauen, oder aufheben
      If Abs(InvertGrayed) = 1 Then
         ' Status umkehren
         If blnGrayed Then
            .fState = .fState And (Not MF_GRAYED)
         Else
            .fState = .fState Or MF_GRAYED
         End If
      ElseIf Abs(Grayed) = 0 Then
         ' Ausgrauen entfernen
         .fState = .fState And Not MF_GRAYED
      ElseIf Abs(Grayed) = 1 Then
         ' Ausgrauen
         .fState = .fState Or MF_GRAYED
      End If
   End With
   
   lngRet = SetMenuItemInfo(mlngMainMenu, ID, 0, udtMenu)
   
   ' Menü neu zeichnen
   DrawMenuBar mlngWindow
   
End Sub

Private Sub CreateFormMenu()
   Dim strOld  As String
   Dim strFind As String
   On Error Resume Next
   
   ' Kein Menüpunkt in Collection, verlassen
   If mcolMenu.Count = 0 Then Exit Sub

   With Me
      ' Fensterhandle suchen
      strFind = "asdfghjk"
      strOld = .Caption
      .Caption = strFind
      mlngWindow = FindWindow(vbNullString, strFind)
      .Caption = strOld
   End With

   CreateMenuVBA mcolMenu
   
   mlngOldWindowProc = SetWindowLong( _
      mlngWindow, _
      GWL_WNDPROC, _
      AddressOf NewCallback)
      
End Sub

Private Sub CreateMenuVBA(colTemp As VariantOptional lngParent As Long)
   Dim blnFirst            As Boolean
   Dim varTemp             As Variant
   Dim udtItem             As MENUITEMINFO
   On Error Resume Next
   
   If lngParent = 0 Then
      ' Mainmenü (unsichtbare Wurzel) erzeugen
      lngParent = CreateMenu()
      ' 1. Rekursionsebene
      blnFirst = True
   End If
   
   For Each varTemp In colTemp
      If VarType(varTemp) = vbObject Then
         ' Struktur ausfüllen lassen
         udtItem = CreateMenuiteminfo(varTemp)
         ' Menüpunkt einfügen
         InsertMenuItem lngParent, 0&, True, udtItem
         ' Rekursiv aufrufen
         CreateMenuVBA varTemp, udtItem.hSubMenu
      End If
   Next
   
   If blnFirst Then
      ' Menü zum Fenster zuweisen
      SetMenu mlngWindow, lngParent
      ' Menü neu zeichnen
      DrawMenuBar mlngWindow
      ' Menühandle des Fensters ermitteln
      mlngMainMenu = GetMenu(mlngWindow)
   End If

End Sub

Private Sub AddMenuVBA( _
   MenuPath As String, _
   Optional ID As Long = 0, _
   Optional Checked As Boolean, _
   Optional Separator As Boolean, _
   Optional Grayed As Boolean)
   Dim varPath    As Variant
   Dim varTemp    As Variant
   Dim strName    As String
   Dim i          As Long
   Dim k          As Long
   Dim colTemp    As Collection
   On Error Resume Next
   
   ' Eine Collection anlegen und füllen, welche
   ' alle Menüpunkte in einer Baumstruktur aufnimmt
   Set varTemp = mcolMenu
   
   ' Pfad in seine einzelnen Elemente splitten
   varPath = Split(MenuPath, "\")
   
   ' Anzahl Elemente ermitteln
   k = UBound(varPath)
   
   For i = 0 To k ' Alle Elemente durchlaufen
      
      ' Das &-Zeichen im Namen löschen
      ' In der Beschriftung (Caption) ist der nächste
      ' Buchstabe im Menü unterstrichen
      strName = Replace(varPath(i), "&", "")
      
      Err.Clear
      
      ' Ev. vorhandenes Element in der Collection
      ' mit gleichen Namen zuweisen
      Set varTemp = varTemp(strName)
      
      If Err.Number <> 0 Then
      ' Kein Element mit dem Namen in Collection vorhanden
      
         ' Neue Collection anlegen
         Set colTemp = New Collection
         
         ' Name (ohne &) und Menütext hinzufügen
         colTemp.Add strName, "Name"
         colTemp.Add varPath(i), "Caption"
         
         If varTemp.Count = 0 Then
            ' Collection einfügen
            varTemp.Add colTemp, strName
         Else
            ' Collection vor Element 1 einfügen,
            ' beim Erzeugen eines Menüpunktes kann nur vor
            ' einem Element eingefügt werden, deshalb wird
            ' hier bereits umgekehrt
            varTemp.Add colTemp, strName, 1
         End If
         
         ' Referenz auf eingefügtes Element setzen
         Set varTemp = varTemp(strName)
         
      End If
      
      If i = k Then
         ' Eigenschaften des im Pfad ganz hinten stehenden
         ' Element speichern
         varTemp.Add CStr(ID), "ID"
         varTemp.Add Abs(CLng(Checked)), "Checked"
         varTemp.Add Abs(CLng(Separator)), "Separator"
         varTemp.Add Abs(CLng(Grayed)), "Grayed"
      End If
      
   Next
   
End Sub

Private Function CreateMenuiteminfo( _
   ByVal varTemp As Variant _
   ) As MENUITEMINFO
   Dim udtItem             As MENUITEMINFO
   Dim varTemp1            As Variant
   Dim strCaption          As String
   Dim strChecked          As String
   Dim strSeparator        As String
   Dim strGreyed           As String
   Dim lngMask             As Long
   Dim lngID               As Long
   Dim lngType             As Long
   Dim lngPopup            As Long
   Dim lngState            As Long
   ' Füllt die Struktur MENUITEMINFO für den
   ' anzulegenden Menüpunkt aus
   On Error Resume Next
   
   ' Element fType beachten
   lngMask = MIIM_TYPE
   
   For Each varTemp1 In varTemp
      If VarType(varTemp1) = vbObject Then
         ' Menüpunkt enthält untergeordnete Menüpunkte
         ' Element hSubMenu beachten
         lngMask = lngMask Or MIIM_SUBMENU
         ' Popupmenü erzeugen
         lngPopup = CreatePopupMenu()
         Exit For
      End If
   Next
   
   ' Informationen über Menüpunkt aus Collection auslesen
   strCaption = varTemp("Caption") ' Darzustellender Text
   strChecked = varTemp("Checked") ' Haken am Menüpunkt
   strSeparator = varTemp("Separator") ' Trennzeile -----
   strGreyed = varTemp("Grayed") ' Menüeintrag ausgegraut
   lngID = varTemp("ID") ' ID zum Auswerten in Subclassf.
   
   If lngID > 0 Then
      ' Element wID beachten
      lngMask = lngMask Or MIIM_ID
   End If
   
   If strSeparator = "1" Then
      ' Typ ist Trennzeile
      lngType = MF_SEPARATOR
   Else
      ' Typ ist Text
      lngType = MF_STRING
   End If
   
   If strChecked = "1" Then
      ' Haken vor Menüpunkt
      lngState = lngState Or MF_CHECKED
      lngMask = lngMask Or MIIM_CHECKMARKS Or MIIM_STATE
   End If
   
   If strGreyed = "1" Then
      ' Menüeintrag ausgrauen
      lngState = lngState Or MF_GRAYED
      lngMask = lngMask Or MIIM_STATE
   End If
   
   ' Struktur ausfüllen
   With udtItem
       .cbSize = Len(udtItem)
       .fState = lngState
       .fMask = lngMask
       .fType = lngType
       .wID = lngID
       .hSubMenu = lngPopup
       .dwTypeData = strCaption
   End With
   
   ' Struktur zurückgeben
   CreateMenuiteminfo = udtItem
   
End Function

Private Sub CleanAll()
   ' Subclassing aufheben
   SetWindowLong mlngWindow, GWL_WNDPROC, mlngOldWindowProc
   ' Menü löschen
   DestroyMenu mlngMainMenu
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   Unload Me
End Sub

Private Sub UserForm_Terminate()
   CleanAll
End Sub
Listing 2

Die Prozedur UserForm_Initialize

Die Ereignisprozedur UserForm_Initialize wird beim Initialisieren der UserForm ausgeführt. Darin werden die zu erstellenden Menüpunkte festgelegt, indem für jeden Menüpunkt je einmal die Prozedur AddMenuVBA aufgerufen wird. In dieser werden alle Menüpunkte, die Pfade und die Eigenschaften in einer Collection gespeichert

Anschließend werden über den Aufruf der Prozedur CreateFormMenu das Menü erzeugt, und die Fensternachrichten umgeleitet.

Die Prozedur UserForm_QueryClose

Die Ereignisprozedur UserForm_QueryClose entlädt die UserForm.

Die Prozedur UserForm_Terminate

Die Ereignisprozedur UserForm_Terminate ruft die Prozedur CleanAll auf.

Die Prozedur AddMenuVBA

Die Prozedur AddMenuVBA wird in der Initialisierungsprozedur der UserForm mehrfach aufgerufen. Darin werden nacheinander alle Menüpunkte, die Pfade und die Eigenschaften in der Collection mcolMenu gespeichert.

Als einziges nicht optionales Argument mit dem Namen MenuPath wird der durch Backslashes (\) getrennte Menüpfad übergeben. An diesem Trennzeichen wird der Pfad in seine einzelnen zu dem eigentlichen Menüpunkt führenden Submenüs aufgetrennt. Vergleichbar ist das mit den Verzeichnissen und der eigentlichen Datei im Dateisystem.

Möchte man das Trennzeichen (\) selbst im Text verwenden, was momentan nicht möglich ist, muss das Beispiel umprogrammiert werden. Dazu müsste man beispielsweise das Zeichen irgendwie maskieren, in der Seitenbeschreibungssprache HTML wird das ja für Umlaute auch so gehandhabt. Möglich wäre auch ein anderes, sonst im Text nicht benutztes Trennzeichen. Ein im Menütext darzustellendes kaufmännischen UND (&) Zeichen muss übrigens doppelt eingegeben werden, um im Text zu erscheinen.

Als zweites Argument kann optional eine ID (Longwert)übergeben werden, mit deren Hilfe man den angeklickten Menüpunkt identifizieren kann. Übergibt man keine ID, hat man auch keine Möglichkeit, auf einen Klick darauf zu Reagieren. Die restlichen drei optionalen Argumente geben an, ob der Menüpunkt ausgegraut, abgehakt oder als Trennzeile erscheinen soll.

In dieser Prozedur ist die Fehlerbehandlung On Error Resume Next eingebaut. Das geschieht deshalb, da immer wieder versucht wird, über Schlüsselnamen auf Einträge in einer Collection zuzugreifen, die zu diesem Zeitpunkt möglicherweise noch gar nicht existieren.

Der Pfad wird also mit der Methode Split in seine Bestandteile zerlegt, als Trennzeichen wird dabei der Backslash verwendet. Nacheinander werden nun alle Elemente des zurückgelieferten Arrays durchlaufen.

Der erste Versuch dabei ist immer der, auf ein Element der klassenweit gültigen Collection mcolMenu zuzugreifen, welches einem Menüpunkt der obersten Ebene entspricht. In unserem Beispiel ist es zu Beginn der Punkt Datei, auf den über den Namen versucht wird, eine Referenz zu bekommen. Dieser Menüpunkt ist, soweit vorhanden, eigentlich eine weitere Collection mit einigen Einträgen und weiteren Collections, welche wiederum Submenüs repräsentieren.

Der Schlüsselname zum Zugriff ist dabei der Menüname, aus dem das Kaufmännische UND (&) entfernt wurde. Existiert kein solcher Eintrag, was man an der Fehlernummer erkennen kann, muss er neu als Collection angelegt werden und schließlich unter dem entsprechenden Schlüsselnamen in der Collection mcolMenu gespeichert werden.

Jede enthaltene Collection kann neben Untermenüs (Submenüs) in Form weiterer Collections noch einige andere Elemente enthalten, welche den Menünamen, den Menütext, die ID und die Informationen enthalten, die Auskunft darüber geben, ob ein Menüpunkt ausgegraut, abgehakt oder als Trennzeile erscheinen soll. Die Schlüsselnamen innerhalb der jeweiligen Collection dazu sind Name, Caption, ID, Grayed, Checked und Separator.

In jedem Fall wird versucht, den Menünamen und den Menütext als Element zu speichern, was aber bei bereits vorhandenen Einträgen fehlschlägt. Deshalb ist es wichtig, bereits beim ersten Setzen eines Pfades die Kaufmännischen UND-Zeichen (&) einzubauen, in späteren Pfaden werden diese ignoriert und können für bereits vorhandene Submenüs weggelassen werden.

Bei jedem weiteren Durchlauf wird nun in der bereits vorhandenen oder neu angelegten Collection versucht, eine Referenz auf einen darin eventuell enthaltenen, untergeordneten Menüpunkt zu bekommen. Dann beginnt das im letzen Absatz beschriebene Spiel von Neuen. Erst im letzten Schleifendurchlauf werden schließlich die als Argument übergebenen Elemente ID, Grayed , Checked und Separator in die zuletzt referenzierte oder neu angelegte Collection geschrieben.

So entsteht nach und nach eine Collection, welche die komplette Menüstruktur in einer Art Baumstruktur mit der Wurzel in der Collection mcolMenu nachbildet. Jeder Aufruf erweitert die Struktur oder setzt bisher fehlende Eigenschaften von vorhandenen Menüs.

Zu Erwähnen ist noch, dass beim Einfügen einer neuer Collection diese immer an die erste Position gesetzt wird, da man beim eigentlichen Erstellen eines Menüs einen Menüpunkt lediglich vor, nicht aber hinter einen bereits vorhandenen Punkt setzen kann. Die Menüstruktur wird in der Collection quasi gespiegelt.

Die Prozedur CreateFormMenu

Die Prozedur CreateFormMenu wird in der Initialisierungsprozedur der UserForm aufgerufen, nachdem durch den Aufruf der Prozedur AddMenuVBA die Menüstruktur in der Collection mcolMenu abgebildet wurde. Existiert kein Menüpunkt in der Collection mcolMenu, wird die Prozedur verlassen.

Als nächstes ermittelt man das Fensterhandle der UserForm, indem man den Fenstertext auf einen möglichst einmaligen Wert setzt und anschließend mit der API FindWindow ein Fenster mit diesem Fenstertext sucht. Anschließend wird der Fenstertext wieder zurückgesetzt.

Durch den Aufruf von CreateMenuVBA wird das Menü erzeugt, man kann an dieser Stelle aber noch nicht auf den Klick auf einen Menüpunkt reagieren. Dazu müssen die Fensternachrichten umgeleitet, werden, indem man die API Allroundfunktion SetWindowLong einsetzt. Durch die Übergabe der Konstanten GWL_WNDPROC wird signalisiert, dass die Nachrichten des als Handle übergebenen Fensters an die Funktion NewCallback umgeleitet werden soll. Der Zeiger auf diese Funktion wird mit AddressOf übergeben.

Wichtig ist der Rückgabewert der API SetWindowLong, dieser ist ein Handle auf die ursprüngliche Nachrichtenfunktion. Das Handle wird in der mappenweit gültigen Variablen mlngOldWindowProc gespeichert.

Die Prozedur CreateMenuVBA

Die Prozedur CreateMenuVBA wird aus der Prozedur CreateFormMenu aufgerufen. Als Parameter colTemp wird im ersten Aufruf die Collection mcolMenu übergeben, in den weiteren rekursiven Aufrufen jeweils die Collection, welche die aktuell anzulegenden Untermenüs enthält. Der zweite Parameter lngParent ist optional und bleibt beim ersten Aufruf leer. In den weiteren Aufrufen enthält dieser die Menühandles des aktuell übergeordneten Menüpunktes.

Im ersten Aufruf wird mit der API CreateMenu das Hauptmenü erzeugt, welches als Wurzel aller untergeordneten Menüpunkte dient. Damit man im weiteren Verlauf der rekursiven Funktion erkennen kann, ob es sich um den ersten Aufruf handelt, wird die Variable blnFirst auf Wahr gesetzt.

Nun werden alle Elemente der Collection colTemp durchlaufen. Handelt es sich bei dem Element um eine Collection, signalisiert das ein Untermenü. Dieses Element wird dann an die Funktion CreateMenuiteminfo übergeben, in der mit Hilfe der darin gespeicherten Informationen die Struktur MENUITEMINFO ausgefüllt wird. Mit deren Hilfe wird mittels der API-Funktion InsertMenuItem der Menüpunkt hinzugefügt.

Anschließend ruft man die Prozedur rekursiv auf und übergibt das aktuelle Element, sowie das Handle des gerade erzeugten Untermenüs, welche in der Struktur MENUITEMINFO als Element .hSubMenu steckt. In dieser neu aufgerufenen Prozedur beginnt das gleiche Spiel in der nächsten Menüebene.

Sind alle Elemente abgearbeitet worden und befindet man sich im ersten Aufruf, wird mit der API SetMenu das erzeugte Menü an die Userform gebunden, mit DrawMenuBar wird das Menü dann angezeigt, bzw neu gezeichnet und mit GetMenü holt man sich das Menühandle der aktuellen UserForm.

Die Funktion CreateMenuiteminfo

Die Funktion CreateMenuiteminfo wird aus der Prozedur CreateMenuVBA aufgerufen. Als Parameter varTemp wird eine Collection übergeben, die den aktuellen Menüpunkt enthält. Zurückgegeben wird die ausgefüllte Struktur MENUITEMINFO.

In einer Schleife werden erst einmal alle Elemente der Collection durchlaufen. Dabei wird nachgeschaut, ob der Menüpunkt untergeordnete Menüs enthält. Ist das der Fall, wird mit der API CreatePopupMenu ein Popupmenü erzeugt, das Handle wird in der Variablen lngPopup gespeichert. Außerdem wird in der Variablen lngMask noch das Flag MIIM_SUBMENU gesetzt.

Anschließend werden über die Schlüsselnamen Name, Caption, ID, Grayed, Checked und Separator die Informationen zum aktuellen Menüpunkt aus der Collection ausgelesen.

Ist die Variable lngID ungleich Null, wird in der Variablen lngMask das Flag MIIM_ID gesetzt.

Besitzt die Variable strChecked den Wert "1", werden in der Variablen lngMask die Flags MIIM_CHECKMARKS und MIIM_STATE, in der Variablen lngState das Flag MF_CHECKED gesetzt. Der Menüpunkt erscheint später mit einem Haken.

Besitzt die Variable strGreyed den Wert "1", wird in der Variablen lngMask das Flag MIIM_STATE, in der Variablen lngState das Flag MF_GRAYED gesetzt. Der Menüpunkt erscheint später ausgegraut, das bedeutet, dass er gleichzeitig auch deaktiviert ist. Enthaltene Submenüs werden auch nicht angezeigt.

Besitzt die Variable strSeparator den Wert "1", wird in der Variablen lngType der Typ MF_SEPARATOR, andernfalls der Typ MF_STRING gesetzt. Der Menüpunkt erscheint später als grauer Trennstrich, ansonsten als normaler Menüpunkt.

Anschließend wird die Struktur udtItem ausgefüllt und als Funktionsergebnis zurückgegeben.

Die öffentliche Prozedur MenuEvent

Die Funktion MenuEvent wird von der Callbackfunktion NewCallback aufgerufen. Als Parameter ID wird die Identifikationsnummer übergeben, die den angeklickten Menüpunkt kennzeichnet.

Neben der obligatorischen Fehlerbehandlung On Error Resume Next wird die übergebene ID ausgewertet. Sie wird mit den beim Erzeugen des Menüs festgelegten IDs verglichen und es werden je nach Menüpunkt Aktionen ausgeführt. Beispielsweise wird einmal mit CallByName eine Prozedur über ihren Namen aufgerufen, ein anderes Mal eine interne Prozedur direkt.

Mit dem Aufruf von ChangeMenuItem kann man den Status und den Text von Menüpunkten ändern.

Setzt man das benannte Argument Grayed auf den Wert 1, wird der als Argument übergebene Menüpunkt ausgegraut, setzt man ihn auf den Wert 0, wird der Menüpunkt wieder aktiviert. Setzt man das benannte Argument InvertGrayed auf den Wert 1, wird der aktuelle Zustand invertiert.

Setzt man das benannte Argument Checked auf den Wert 1, wird der als Argument übergebene Menüpunkt abgehakt, setzt man ihn auf den Wert 0, wird der Haken wieder entfernt. Setzt man das benannte Argument InvertChecked auf den Wert 1, wird der aktuelle Zustand invertiert.

Indem man über das benannte Argument MenuText einen Text übergibt, kann man den Text eines Menüpunktes anpassen.

Die Prozedur ChangeMenuItem

Die Prozedur ChangeMenuItem ändert den Status und den Text von Menüpunkten. Damit bereits bestehende Einstellungen beibehalten werden, muss man eine Struktur vom Typ MENUITEMINFO mit Werten des aktuellen Menüpunktes füllen.

Dazu werden in der Struktur verschiedene Flags gesetzt, die angeben, welche Werte überhaupt ausgelesen werden sollen. Möchte man den Menütext auslesen, muss noch zusätzlich ein Stringpuffer erzeugt werden, in der Struktur an das Element dwTypeData und dessen Länge an das Element cch übergeben werden. Der Vollständigkeit halber wird das hier unterstützt. Außerdem wird noch die Strukturlänge über das Element cbSize angegeben.

Die API-Funktion GetMenuItemInfo liest schließlich die Werte aus. Dazu werden das Menühandle, die ID und die vorbelegte Struktur übergeben. Der dritte Parameter der API wird auf Null gesetzt und gibt an, dass der entsprechende Menüpunkt über die ID identifiziert wird.

Nach dem Auslesen wird je nach dem, welche Variablen übergeben wurden und welche Werte diese besitzen, die Struktur vom Typ MENUITEMINFO an die zu setzenden Werte angepasst.

Besitzt die übergebene Variable Grayed den Wert 1, wird der als ID übergebene Menüpunkt ausgegraut, besitzt sie den Wert 0, wird der Menüpunkt wieder aktiviert. Besitzt die übergebene Variable InvertGrayed den Wert 1, wird der aktuelle Zustand invertiert.

Setzt man das benannte Argument Checked auf den Wert 1, wird der als Argument übergebene Menüpunkt abgehakt, setzt man ihn auf den Wert 0, wird der Haken wieder entfernt. Setzt man das benannte Argument InvertChecked auf den Wert 1, wird der aktuelle Zustand invertiert.

Indem man über das benannte Argument MenuText einen Text übergibt, kann man den Text eines Menüpunktes anpassen.

Die API-Funktion SetMenuItemInfo schreibt schließlich die geänderten Werte zurück. Dazu werden das Menühandle, die ID und die vorbelegte Struktur übergeben. Der dritte Parameter der API wird auf Null gesetzt und gibt an, dass der entsprechende Menüpunkt über die ID identifiziert wird. Mit der API DrawMenuBar wird schließlich das Menü neu gezeichnet.

Die Prozedur CleanAll

Die Prozedur CleanAll setzt das Subclassing zurück, indem man die API Allroundfunktion SetWindowLong einsetzt. Durch die Übergabe der Konstanten GWL_WNDPROC wird signalisiert, dass die Nachrichten des als Handle übergebenen Fensters umgeleitet werden soll. Als Funktion, auf die umgeleitet werden soll, wird die in der Variablen mlngOldWindowProc gespeicherte ursprüngliche Fensterfunktion benutzt. Anschließend wird das angelegte Menü mit der API DestroyMenu gelöscht.