Const My = &H100&
Const MF_STRING = &H0&
Const MF_POPUP = &H10&
Const MF_SEPARATOR = &H800&
Const MF_BYCOMMAND = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_ENABLED = &H0&
Const NN = -4


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 String) As Long
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wflags As Long, ByVal x As Long, ByVal y As Long, ByVal nreserved As Long, ByVal hwnd As Long, lprc As Rect) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpwindowname As String) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Boolean
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
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 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

Dim OldWndProc As Long
Dim hwnd As Long

Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lReturn As Long

  '??????? ???????? ?????????? ????????? ??????????? ??????? ????????? ?????????, ? ????? ????
  lReturn = CallWindowProc(OldWndProc, hwnd, Msg, wParam, lParam)
'  Select Case Msg '????????? ?????????
'    Case WM_MENUSELECT '???? ?????? ???, ?? ????????? ????????? ???????? (??????
'                       'WM_MENUSELECT ????? ???? ????? ?????? ?????????, ?????????)
'   ...
'    ...
'  End Select
  WindowProc = lReturn '?????? ???????? ???????
End Function

Private Sub UserForm_Activate()
  Dim hMenu As Long
  Dim hPopupMenu As Long
  Dim hwnd As Long
  Dim j As Long
  
  hwnd = FindWindow(vbNullString, "UserForm1")
  hMenu = CreateMenu()
  hPopupMenu = CreatePopupMenu()
  AppendMenu hMenu, MF_STRING Or MF_POPUP, hPopupMenu, "File"
  AppendMenu hMenu, MF_STRING, 600, "Help"
  AppendMenu hPopupMenu, MF_STRING, 600, "New..."
  AppendMenu hPopupMenu, MF_STRING, 600, "Open..."
  AppendMenu hPopupMenu, MF_SEPARATOR, 600, ""
  AppendMenu hPopupMenu, MF_STRING, 600, "Exit..."
  SetMenu hwnd, hMenu
  'j = VBA.Int(AddressOf WindowProc)
  OldWndProc = SetWindowLong(hwnd, NN, AddressOf WindowProc)
End Sub

Private Sub UserForm_Deactivate()
  SetWindowLong hwnd, NN, OldWndProc
End Sub

Function LowOrd(DbleWord As Long) As Integer
    If DbleWord And &H8000& Then
        LowOrd = &H8000 Or (DbleWord And &H7FFF&)
    Else
        LowOrd = DbleWord And &HFFFF&
    End If
End Function

Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lReturn As Long

  
  lReturn = CallWindowProc(OldWndProc, hwnd, Msg, wParam, lParam)
  Select Case Msg
    Case WM_MENUSELECT
      Select Case LowOrd(wParam)
        Case 2
          MsgBox "About"
        Case 10
          MsgBox "New..."
        Case 20
          MsgBox "Open..."
        Case 30
          MsgBox "Exit..."
      End Select
  End Select
  WindowProc = lReturn
End Function

...
  Case 10
     UserForm2.Show vbModal
...

...
  Case 10
    SetWindowLong...'Временно выбрать родной обработчик сообщений окна, из которого вызывается форма UserForm2 
    UserForm2.Show vbModal

...