Userform Menü Datei.. bearbeiten .. Untermenüs
15.11.2007 10:34:00
chris
eine frage heute zu userforms und menüs.
Es gibt ja mehere codes um menüs in userforms zu erstellen ich habe mich für diesen entschieden.
Nur leider bekomme ich nicht hin was ich noch gerne möchte..
und zwar habe ich mit dem code(unten) ein Menü oben an der userform erstellt..
3 Stück mit jeweils untermenüs.
Wie schaffe ich es in dem untermenü 3 "irgendein neues menü"
noch ein untermenü zu erstellen das geöffnet(aufgeklappt) wird wo dann noch zusätzliche unterpunkte eingetragen und ausgewählt werden können ?
(Also zum öffnen des menüs noch ein kleiner pfeil nach rechts erscheint. und darunter noch Menüpunkte sind)
Vielen Dank für eure Hilfe gruß Chris
Dim objDieseUF As New clsUF1
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Private Declare Function CreateMenu Lib "user32.dll" () As Long
Private Declare Function DestroyMenu Lib "user32.dll" ( _
ByVal glngMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function SetMenu Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal glngMenu As Long) As Long
Private Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" ( _
ByVal hMenu As Long, _
ByVal un As Long, _
ByVal bool As Long, _
ByRef 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 hwndForm As Long
Private hWndMenu As Long
Private Const GC_CLASSNAMEMSEXCELFORM = "ThunderDFrame"
Private Sub prcMakeMenu()
Dim MnuItem As MENUITEMINFO
Dim lngSub As Long
hWndMenu = CreateMenu()
With MnuItem
.cbSize = Len(MnuItem)
'Hauptmenü "Datei"
lngSub = CreatePopupMenu()
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 100&
.hSubMenu = lngSub
.dwTypeData = "&Datei"
InsertMenuItem hWndMenu, 0&, True, MnuItem
'Unter Menü Datei ( neue Ändernummer & Beenden )
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_CHECKMARKS Or MIIM_STATE
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 110&
.hSubMenu = lngSub
.dwTypeData = "&Neu Änderungsnummer"
InsertMenuItem lngSub, 0&, True, MnuItem
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_STATE
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 120&
.hSubMenu = lngSub
.dwTypeData = "&Beenden"
InsertMenuItem lngSub, 1&, True, MnuItem
'----------------------------------------------------------------------------------------------- _
'----------------------------------------------------------------------------------------------- _
'Hauptmenü "?"
lngSub = CreatePopupMenu()
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING
.wID = 200&
.hSubMenu = lngSub
.dwTypeData = "&?"
InsertMenuItem hWndMenu, 1&, True, MnuItem
'Unter Menü "?" ( Hilfe & Über )
.fMask = MIIM_TYPE Or MIIM_ID
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 210&
.hSubMenu = 0
.dwTypeData = "&Hilfe"
InsertMenuItem lngSub, 0&, True, MnuItem
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING
.wID = 200&
.hSubMenu = lngSub
.dwTypeData = "&?"
InsertMenuItem hWndMenu, 1&, True, MnuItem
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 220&
.hSubMenu = 0
.dwTypeData = "&Über"
InsertMenuItem lngSub, 0&, True, MnuItem
'----------------------------------------------------------------------------------------------- _
'----------------------------------------------------------------------------------------------- _
'Hauptmenü "irgendein neues Menü"
lngSub = CreatePopupMenu()
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 120&
.hSubMenu = lngSub
.dwTypeData = "&irgendein neues Menü"
InsertMenuItem hWndMenu, 2&, True, MnuItem
'Unter Menü "irgendein neues Menü" ( noch leer )
.fMask = MIIM_TYPE Or MIIM_ID
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 310&
.hSubMenu = 0
.dwTypeData = "&unter 1"
InsertMenuItem lngSub, 0&, True, MnuItem
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_CHECKMARKS Or MIIM_STATE
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 320&
.hSubMenu = 0
.dwTypeData = "&unter 2"
InsertMenuItem lngSub, 1&, True, MnuItem
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_CHECKMARKS Or MIIM_STATE
.fType = MF_STRING
.fState = 0 'MF_CHECKED
.wID = 330&
.hSubMenu = 0
.dwTypeData = "&unter 3"
InsertMenuItem lngSub, 2&, True, MnuItem
End With
SetMenu hwndForm, hWndMenu
DrawMenuBar hwndForm
glngOldProc = SetWindowLong(hwndForm, GWL_WNDPROC, AddressOf NewProc)
End Sub
Private Sub UserForm_Activate()
Set objDieseUF.formular = Me
hwndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, Me.Caption)
Call prcMakeMenu
ShowModal = True
Application.WindowState = xlMinimized
End Sub
Private Sub UserForm_Initialize()
Me.Repaint
Me.StartUpPosition = 1
End Sub