wie kann ich in angehängten Code weitere Sub-Menüs einbauen (evtl. mit Bild!)
Vielen Dank!
Mike
' in Standardmodul
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
Private Const WM_COMMAND As Long = &H111
Public glngOldProc As Long
Public Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_COMMAND Then
If lParam = 0 Then
Select Case wParam
Case Is = 1100
MsgBox "'AA' gewählt"
Case Is = 1200
MsgBox "'AB' gewählt"
Case Is = 2100
MsgBox "'BA' gewählt"
Case Is = 2200
MsgBox "'BB' gewählt"
End Select
End If
End If
NewProc = CallWindowProc(glngOldProc, hWnd, Msg, wParam, lParam)
End Function
' in UserForm
Option Explicit
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 FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) 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 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 Const MF_CHECKED = &H8&
Private Const MF_APPEND = &H100&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MIIM_TYPE = &H10
Private Const MIIM_SUBMENU = &H4
Private Const MIIM_CHECKMARKS = &H8
Private Const GWL_WNDPROC = (-4)
Private mlngUserform As Long
Private mlngMenuParent As Long
Private Sub MakeMenu()
Dim MnuItem As MENUITEMINFO
Dim lngSub As Long
' Mainmenü anlegen
mlngMenuParent = CreateMenu()
With MnuItem
' Länge der Struktur
.cbSize = Len(MnuItem)
' 1. Submenü anlegen
lngSub = CreatePopupMenu()
' 1. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 1000& ' Eindeutige ID
.hSubMenu = lngSub ' Angabe des verbundenen Submenüs
.dwTypeData = "A" ' Menütext
' Menüpunkt ins Mainmenü einfügen
InsertMenuItem mlngMenuParent, 0&, True, MnuItem
' 1. Submenüpunkt, 1. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_STATE
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
'.fState = MF_GRAYED ' Ausgegraut
.wID = 1100& ' Eindeutige ID
.hSubMenu = lngSub ' enthält kein Submenü
.dwTypeData = "AA" ' Menütext
' Menüpunkt ins 1. Submenü einfügen
InsertMenuItem lngSub, 0&, True, MnuItem
' 2. Submenüpunkt, 1. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_STATE
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
'.fState = MF_GRAYED ' Ausgegraut
.wID = 1200& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "AB" ' Menütext
' Menüpunkt ins 1. Submenü einfügen
InsertMenuItem lngSub, 1&, True, MnuItem
' 2. Submenü anlegen
lngSub = CreatePopupMenu()
' 2. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 2000& ' Eindeutige ID
.hSubMenu = lngSub ' Angabe des verbundenen Submenüs
.dwTypeData = "B" ' Menütext
' Menüpunkt ins Mainmenü einfügen
InsertMenuItem mlngMenuParent, 1&, True, MnuItem
' 1. Submenüpunkt, 2. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 2100& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "BA" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngSub, 0&, True, MnuItem
' 2. Submenüpunkt, 2. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_CHECKMARKS Or MIIM_STATE
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.fState = MF_CHECKED ' Haken gesetzt
.wID = 2200& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "BB" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngSub, 1&, True, MnuItem
End With
' Menü mit Userform verbinden
SetMenu mlngUserform, mlngMenuParent
DrawMenuBar mlngUserform
' WindowProc umleiten
glngOldProc = SetWindowLong(mlngUserform, GWL_WNDPROC, AddressOf NewProc)
End Sub
Private Sub UserForm_Terminate()
DestroyMenu mlngMenuParent
SetWindowLong mlngUserform, GWL_WNDPROC, glngOldProc
End Sub
Private Sub UserForm_Activate()
mlngUserform = FindWindow(vbNullString, Me.Caption)
MakeMenu
End Sub