Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Userform Menü Datei.. bearbeiten .. Untermenüs

Betrifft: Userform Menü Datei.. bearbeiten .. Untermenüs von: chris b.
Geschrieben am: 15.11.2007 10:34:38

Hallo VBA Experten,
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


  

Betrifft: AW: Userform Menü Datei.. bearbeiten .. Untermenüs von: Jens
Geschrieben am: 17.11.2007 12:03:46

Hi,

mit dem Problem bist du in einem VB-Forum besser aufgehoben, z.B. www.spotlight.de

mfg Jens


 

Beiträge aus den Excel-Beispielen zum Thema "Userform Menü Datei.. bearbeiten .. Untermenüs"