Option Explicit
Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function CreateMenu Lib "user32" () As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
(ByVal hMenu As Long, ByVal wFlags As Long, _
ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, _
ByVal hMenu As Long) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare 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
Private Const MF_STRING = &H0&
Private Const MF_POPUP As Long = &H10&
Private Const GWL_WNDPROC = -4
Private hMenu As Long, hForm As Long, rv As Long
Private hPopUpMenu As Long
Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'Process message of interest here
'Call original window procedure
End Function
Private Sub UserForm_Activate()
hForm = FindWindow("ThunderDFrame", "TestMenu")
Debug.Print hForm
hMenu = CreateMenu()
Debug.Print hMenu
hPopUpMenu = CreatePopupMenu()
rv = AppendMenu(hPopUpMenu, MF_STRING, 40000, "Menu Item 1")
Debug.Print rv
rv = AppendMenu(hPopUpMenu, MF_STRING, 40001, "Menu Item 2")
Debug.Print rv
rv = AppendMenu(hMenu, MF_POPUP, hPopUpMenu, "Top-Level")
rv = SetMenu(hForm, hMenu)
' hprevwndproc = SetWindowLong(hForm, GWL_WNDPROC, AddressOf WindowProc)
'
'Debug.Print hprevwndproc
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
DestroyMenu hPopUpMenu
DestroyMenu hMenu
End Sub