Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1504to1508
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1504to1508
1504to1508
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

selbe Menüleiste in meheren Userforms

selbe Menüleiste in meheren Userforms
16.07.2016 13:51:05
Friedl
Hallo liebe Leute,
Ich bräuchte wieder einmal etwas Hilfe.
Ich habe eine Menüleiste , diese möchte ich in mehreren Userforms nutzen ohne Sie in jede Userform zu schreiben. Was muss ich dafür tun? Klassenmodul? nur Modul?
hier der Code.
--------------------------------------------------------
Modul
---------------------------------------------------------
Option Explicit
Private Declare PtrSafe 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 = 120
Unload UserForm_Menü
ThisWorkbook.Save
Application.Quit
Case Is = 210
'Call Anmeldungen.AL_drucken
Case Is = 220
Call Anmeldungen.AL_drucken
Case Is = 331
Call IBK_PH.IBK_BL_drucken
Case Is = 332
Call IBK_PH.IBK_PL_drucken
Case Is = 333
Call IBK_PH.IBK_AEL_drucken
Case Is = 334
Call IBK_PH.IBK_AAL_drucken
Case Is = 335
Call IBK_PH.IBK_BF_drucken
Case Is = 336
Call IBK_PH.IBK_FZ_drucken
Case Is = 337
Call IBK_PH.IBK_ZÜ_drucken
Case Is = 338
Call IBK_PH.IBK_TGÜ_drucken
End Select
End If
End If
NewProc = CallWindowProc(glngOldProc, hWnd, Msg, wParam, lParam)
End Function

---------------------------------------------------------------------
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
Dim lngUntermenü     As Long
Dim lngHauptmenü1    As Long
Dim lngHauptmenü2    As Long
Dim lngHauptmenü3    As Long
' Mainmenü anlegen
mlngMenuParent = CreateMenu()
lngHauptmenü1 = CreatePopupMenu()
lngHauptmenü2 = CreatePopupMenu()
lngHauptmenü3 = CreatePopupMenu()
'lngHauptmenü4 = CreatePopupMenu()
'lngHauptmenü5 = CreatePopupMenu()
lngUntermenü = CreatePopupMenu()
'lngUntermenü1 = CreatePopupMenu()
'lngUntermenü2 = CreatePopupMenu()
With MnuItem
' Länge der Struktur
.cbSize = Len(MnuItem)
' 1. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 100& ' Eindeutige ID
.hSubMenu = lngHauptmenü1 ' Angabe des verbundenen Submenüs
.dwTypeData = "&Datei" ' Menütext
' 1. Hauptmenü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 = 120& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Beenden" ' Menütext
' Menüpunkt ins 1. Submenü einfügen
InsertMenuItem lngHauptmenü1, 0&, True, MnuItem
' 2. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 200& ' Eindeutige ID
.hSubMenu = lngHauptmenü2 ' Angabe des verbundenen Submenüs
.dwTypeData = "&Anmeldung" ' 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 = 210& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Neue Anmeldung" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngHauptmenü2, 0&, True, MnuItem
' 2. Submenüpunkt, 2. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 220& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Liste Anmeldungen" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngHauptmenü2, 1&, True, MnuItem
'-------------------------------------------------------------------------------------------- _
_
' 3. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 300& ' Eindeutige ID
.hSubMenu = lngHauptmenü3 ' Angabe des verbundenen Submenüs
.dwTypeData = "&PH-Innsbruck" ' Menütext
' Menüpunkt ins Mainmenü einfügen
InsertMenuItem mlngMenuParent, 2&, True, MnuItem
'________
' 1. Submenüpunkt, 3. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 310& ' Eindeutige ID
.hSubMenu = 0 ' enthält ein Submenü
.dwTypeData = "&Top" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngHauptmenü3, 0&, True, MnuItem
' 2. Submenüpunkt, 3. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 320& ' Eindeutige ID
.hSubMenu = 0 ' enthält ein Submenü
.dwTypeData = "&Bewohner" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngHauptmenü3, 1&, True, MnuItem
' 3. Submenüpunkt, 3. Hauptmenü
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
.fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap)
.wID = 330& ' Eindeutige ID
.hSubMenu = lngUntermenü ' enthält ein Submenü
.dwTypeData = "&Listen" ' Menütext
' Menüpunkt ins 2. Submenü einfügen
InsertMenuItem lngHauptmenü3, 2&, True, MnuItem
'________
'1. Untermenü, 3. Submenü, 3. 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 = 331& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Liste Bewohnern" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 0&, True, MnuItem
'2. Untermenü, 3. Submenü, 3. 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 = 332& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Postliste" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 1&, True, MnuItem
'3. Untermenü, 3. Submenü, 3. 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 = 333& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&aktuelle Einzüge" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 2&, True, MnuItem
'4. Untermenü, 3. Submenü, 3. 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 = 334& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&aktuelle Auszüge" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 3&, True, MnuItem
'5. Untermenü, 3. Submenü, 3. 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 = 335& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Befristungenn" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 4&, True, MnuItem
'6. Untermenü, 3. Submenü, 3. 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 = 336& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&freie Zimmer" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 5&, True, MnuItem
'7. Untermenü, 3. Submenü, 3. 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 = 337& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&Übersicht" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 6&, True, MnuItem
'8. Untermenü, 3. Submenü, 3. 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 = 338& ' Eindeutige ID
.hSubMenu = 0 ' enthält kein Submenü
.dwTypeData = "&TG-Plan" ' Menütext
' Untermenüpunkt einfügen
InsertMenuItem lngUntermenü, 7&, 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 Function GetMyHandle() As Long

Dim strMe   As String

Dim strFind As String

strFind = "asdfghjk"

strMe = Me.Caption

Me.Caption = strFind

GetMyHandle = FindWindow(vbNullString, Me.Caption)

Me.Caption = strMe

End Function



Private Sub UserForm_QueryClose(Cancel As Integer, _

CloseMode As Integer)

Unload Me

End Sub



Private Sub UserForm_Terminate()

DestroyMenu mlngMenuParent

SetWindowLong mlngUserform, GWL_WNDPROC, glngOldProc

End Sub

Public Sub UserForm_Initialize()
mlngUserform = GetMyHandle  'Menüleiste
MakeMenu
End Sub
Danke für eure Hilfe
Gruß
Friedl

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: selbe Menüleiste in meheren Userforms
16.07.2016 14:59:09
Friedl
.
AW: selbe Menüleiste in meheren Userforms
16.07.2016 15:43:11
Hajo_Zi
warum offen. Nur wenige sehe Deine Datei und die UserForm mit Menüleiste?
Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.
Ein Nachbau sieht meist anders aus als das Original.
Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Test, Mappe, Beispiel usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.

Anzeige
AW: selbe Menüleiste in meheren Userforms
16.07.2016 16:44:03
Friedl
Vielleicht Hilft das.
https://www.herber.de/bbs/user/107061.xlsm
In der Userorm Menü ist die Menüleiste welche ich in allen anderen Userform auch haben möchte ohne das ich diese in jede Userform schreiben muss.
DAnke
Gruß
Friedl
AW: selbe Menüleiste in meheren Userforms
16.07.2016 16:52:29
Hajo_Zi
Das UIst keine Menüleiste sondern Schalter. Warum Zig Userformen mit den gleichen Scahltern? Warum nicht nur eine?
Gruß Hajo
AW: selbe Menüleiste in meheren Userforms
16.07.2016 17:00:39
Friedl
Sorry. nicht die in der Mitte.
Links oben am Bilschirmrand. Datei Anmeldung PH-innsbruck ....
Anzeige
AW: selbe Menüleiste in meheren Userforms
16.07.2016 17:32:50
Mullit
Hallo,
im Prinzip kannst Du Deine Api-Geschosse in ein Standardmodul auslagern und nur die Aufrufe ín der Form lassen:
'------------------------------------------------------------------------- 
'UserForm 
'------------------------------------------------------------------------- 

Option Explicit

Private Sub UserForm_Terminate()
  Call DestroyMenu(glngMenuParent)
  Call SetWindowLong(glngUserform, GWL_WNDPROC, glngOldProc)
End Sub

Private Sub UserForm_Initialize()
    glngUserform = GetMyHandle(probjUserForm:=Me)
    Call MakeMenu(probjUserForm:=Me) '// Menüleiste 
End Sub

'--------------------------------------------------------- 
'Modul 
'--------------------------------------------------------- 

Option Explicit
Option Private Module

Private Declare PtrSafe Function CallWindowProc Lib "user32.dll" 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 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
Public 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, _
    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 As Long = &H8&
Private Const MF_APPEND As Long = &H100&
Private Const MF_DISABLED As Long = &H2&
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 WM_COMMAND As Long = &H111

Public Const GWL_WNDPROC As Long = (-4)

Private lobjUserForm As Object

Public glngUserform As Long
Public glngMenuParent As Long

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 = 120
               Call Unload(Object:=lobjUserForm)
               Set lobjUserForm = Nothing
               Call ThisWorkbook.Save
               Call Application.Quit
               Case Is = 210
                   Call Anmeldungen.AL_drucken
               Case Is = 220
                   Call Anmeldungen.AL_drucken
               Case Is = 331
                   Call IBK_PH.IBK_BL_drucken
               Case Is = 332
                   Call IBK_PH.IBK_PL_drucken
               Case Is = 333
                   Call IBK_PH.IBK_AEL_drucken
               Case Is = 334
                   Call IBK_PH.IBK_AAL_drucken
               Case Is = 335
                   Call IBK_PH.IBK_BF_drucken
               Case Is = 336
                   Call IBK_PH.IBK_FZ_drucken
               Case Is = 337
                   Call IBK_PH.IBK_ZÜ_drucken
               Case Is = 338
                   Call IBK_PH.IBK_TGÜ_drucken
           End Select
        End If
     End If
     NewProc = CallWindowProc(glngOldProc, hWnd, Msg, wParam, lParam)
  End Function

Public Sub MakeMenu(ByRef probjUserForm As Object)
  Dim MnuItem          As MENUITEMINFO
  Dim lngSub           As Long
  Dim lngUntermenü     As Long
  Dim lngHauptmenü1    As Long
  Dim lngHauptmenü2    As Long
  Dim lngHauptmenü3    As Long


     ' Mainmenü anlegen 
     glngMenuParent = CreateMenu()
     lngHauptmenü1 = CreatePopupMenu()
     lngHauptmenü2 = CreatePopupMenu()
     lngHauptmenü3 = CreatePopupMenu()
     'lngHauptmenü4 = CreatePopupMenu() 
     'lngHauptmenü5 = CreatePopupMenu() 
     lngUntermenü = CreatePopupMenu()
     'lngUntermenü1 = CreatePopupMenu() 
     'lngUntermenü2 = CreatePopupMenu() 
     Set lobjUserForm = probjUserForm

     With MnuItem
         ' Länge der Struktur 
         .cbSize = Len(MnuItem)

         ' 1. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 100& ' Eindeutige ID 
         .hSubMenu = lngHauptmenü1 ' Angabe des verbundenen Submenüs 
         .dwTypeData = "&Datei" ' Menütext 
         ' 1. Hauptmenüpunkt ins Mainmenü einfügen 
         Call InsertMenuItem(glngMenuParent, 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 = 120& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Beenden" ' Menütext 
         ' Menüpunkt ins 1. Submenü einfügen 
         Call InsertMenuItem(lngHauptmenü1, 0&, True, MnuItem)

    '--------------------------------------------------------------------------------------- 

         ' 2. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 200& ' Eindeutige ID 
         .hSubMenu = lngHauptmenü2 ' Angabe des verbundenen Submenüs 
         .dwTypeData = "&Anmeldung" ' Menütext 
         ' Menüpunkt ins Mainmenü einfügen 
         Call InsertMenuItem(glngMenuParent, 1&, True, MnuItem)

      '________
 
         ' 1. Submenüpunkt, 2. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 210& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Neue Anmeldung" ' Menütext 
         ' Menüpunkt ins 2. Submenü einfügen 
         Call InsertMenuItem(lngHauptmenü2, 0&, True, MnuItem)

          ' 2. Submenüpunkt, 2. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 220& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Liste Anmeldungen" ' Menütext 
         ' Menüpunkt ins 2. Submenü einfügen 
         Call InsertMenuItem(lngHauptmenü2, 1&, True, MnuItem)
     '-------------------------------------------------------------------------------------------- _
 _
  ---- 

         ' 3. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 300& ' Eindeutige ID 
         .hSubMenu = lngHauptmenü3 ' Angabe des verbundenen Submenüs 
         .dwTypeData = "&PH-Innsbruck" ' Menütext 
         ' Menüpunkt ins Mainmenü einfügen 
         Call InsertMenuItem(glngMenuParent, 2&, True, MnuItem)

    '________
 
         ' 1. Submenüpunkt, 3. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 310& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält ein Submenü 
         .dwTypeData = "&Top" ' Menütext 
         ' Menüpunkt ins 2. Submenü einfügen 
         Call InsertMenuItem(lngHauptmenü3, 0&, True, MnuItem)

         ' 2. Submenüpunkt, 3. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 320& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält ein Submenü 
         .dwTypeData = "&Bewohner" ' Menütext 
         ' Menüpunkt ins 2. Submenü einfügen 
         Call InsertMenuItem(lngHauptmenü3, 1&, True, MnuItem)

         ' 3. Submenüpunkt, 3. Hauptmenü 
         .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_SUBMENU
         .fType = MF_STRING ' Text als Menüpunkt ( ev. Bitmap) 
         .wID = 330& ' Eindeutige ID 
         .hSubMenu = lngUntermenü ' enthält ein Submenü 
         .dwTypeData = "&Listen" ' Menütext 
         ' Menüpunkt ins 2. Submenü einfügen 
         Call InsertMenuItem(lngHauptmenü3, 2&, True, MnuItem)

      '________
 
         '1. Untermenü, 3. Submenü, 3. 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 = 331& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Liste Bewohnern" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 0&, True, MnuItem)

         '2. Untermenü, 3. Submenü, 3. 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 = 332& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Postliste" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 1&, True, MnuItem)

         '3. Untermenü, 3. Submenü, 3. 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 = 333& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&aktuelle Einzüge" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 2&, True, MnuItem)

         '4. Untermenü, 3. Submenü, 3. 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 = 334& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&aktuelle Auszüge" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 3&, True, MnuItem)

         '5. Untermenü, 3. Submenü, 3. 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 = 335& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Befristungenn" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 4&, True, MnuItem)

         '6. Untermenü, 3. Submenü, 3. 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 = 336& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&freie Zimmer" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 5&, True, MnuItem)

         '7. Untermenü, 3. Submenü, 3. 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 = 337& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&Übersicht" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 6&, True, MnuItem)

         '8. Untermenü, 3. Submenü, 3. 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 = 338& ' Eindeutige ID 
         .hSubMenu = 0 ' enthält kein Submenü 
         .dwTypeData = "&TG-Plan" ' Menütext 
         ' Untermenüpunkt einfügen 
         Call InsertMenuItem(lngUntermenü, 7&, True, MnuItem)


     End With

     ' Menü mit Userform verbinden 
     Call SetMenu(glngUserform, glngMenuParent)
     Call DrawMenuBar(glngUserform)

     ' WindowProc umleiten 
     glngOldProc = SetWindowLong(glngUserform, _
        GWL_WNDPROC, AddressOf NewProc)

  End Sub

  Public Function GetMyHandle(ByRef probjUserForm As Object) As Long

     Dim strMe As String

     Dim strFind As String

     strFind = "asdfghjk"

     strMe = probjUserForm.Caption

     probjUserForm.Caption = strFind

     GetMyHandle = FindWindow(vbNullString, probjUserForm.Caption)

     probjUserForm.Caption = strMe

  End Function





VBA/HTML - CodeConverter für Office-Foren

AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 14

Gruß, Mullit
Anzeige
AW: selbe Menüleiste in meheren Userforms
16.07.2016 18:20:58
Friedl
Hallo Multi,
Funktioniert soweit Super. Danke!
Nur beim schließen bringt er eine Fehlermeldung.
Mehrdeutiger NAme:~
Option Explicit
Private Sub UserForm_Terminate()
Call DestroyMenu(glngMenuParent)
Call SetWindowLong(glngUserform, GWL_WNDPROC, glngOldProc) 'glngOldProc ist dabei markiert.
End Sub


Private Sub UserForm_Initialize()
glngUserform = GetMyHandle(probjUserForm:=Me)
Call MakeMenu(probjUserForm:=Me) '// Menüleiste
End Sub

Weist Du rat?
Gruß
Friedl
AW: selbe Menüleiste in meheren Userforms
16.07.2016 18:29:07
Mullit
Hallo,
ja, die Deklaration 
Public glngOldProc As Long

darf nur einmal in dem Modul mit dem ausgelagerten Code vorkommen, Du hast sie irgendwo noch ein weiteres mal stehen: die mußt Du löschen....
Gruß, Mullit
Anzeige
AW: selbe Menüleiste in meheren Userforms
16.07.2016 18:36:57
Friedl
Vielen Dank, Perfect.
Gruß Friedl
...ok, prima....owT
16.07.2016 19:05:48
Mullit
AW: selbe Menüleiste in meheren Userforms
16.07.2016 17:46:02
Mullit
Hallo,
...uups, das würde man besser noch so schreiben: 
'...
Private Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
'...

Gruß, Mullit
AW: selbe Menüleiste in meheren Userforms
16.07.2016 18:30:21
Friedl
Hallo Multi,
Funktioniert soweit Super. Danke!
Nur beim schließen bringt er eine Fehlermeldung.
Mehrdeutiger NAme:~
Option Explicit
Private Sub UserForm_Terminate()
Call DestroyMenu(glngMenuParent)
Call SetWindowLong(glngUserform, GWL_WNDPROC, glngOldProc) 'glngOldProc ist dabei markiert.
End Sub

Private Sub UserForm_Initialize()
glngUserform = GetMyHandle(probjUserForm:=Me)
Call MakeMenu(probjUserForm:=Me) '// Menüleiste
End Sub

Weist Du rat?
Gruß
Friedl
Anzeige
AW: selbe Menüleiste in meheren Userforms
16.07.2016 18:37:53
Mullit
Hallo (...Mullit...),
...s.o. darf nur einmal im Projekt vorkommen...
Public glngOldProc As Long





VBA/HTML - CodeConverter für Office-Foren

AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 14

Gruß, Mullit
Anzeige
selbe Menüleiste in meheren Userforms
17.07.2016 08:44:13
Helmut
Hallo Friedl,
könntest du deine fertige Datei mit Code von Mullit bitte hochladen?
Ich habe ein ähnliches Problem, komme aber mit dem Code nicht zurecht :-(
LG
Helmut

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige