Excel VBA 窗体UserForm制作菜单栏

窗体

VB/VBA _API函数接口合集

效果

窗体代码

'--------------------------------------------------------
'->Forms
'  Module
'  ClassModules
'--------------------------------------------------------
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Private Declare Function CreateMenu 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 DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function CreatePopupMenu Lib "user32" () 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const MF_STRING = &H0&
Private Const MF_POPUP = &H10&
Private Const MF_SEPARATOR = &H800&


Dim MenuWnd As Long, Dump As Long, PopupMenuID As Long, PopupMenuWnd As Long, MenuID As Long


Private Sub UserForm_Initialize()
    If Val(Application.Version) < 9 Then
        hwnd = FindWindow("ThunderXFrame", Me.Caption)
    Else
        hwnd = FindWindow("ThunderDFrame", Me.Caption)
    End If
    MenuWnd = CreateMenu()
    
    PopupMenuID = CreatePopupMenu()
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "Setting(&X)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 100, "save(&S)...")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 101, "backup(&E)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 102, "Exit(&X)")
    
    PopupMenuID = CreatePopupMenu()
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "Review(&P)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 110, "Record(&L)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 111, "Review(&C)")
    
    PopupMenuID = CreatePopupMenu()
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "Tools(&Z)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 112, "Tuninghelper(&T)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 113, "Kgthelper(&J)")
    
    PopupMenuID = CreatePopupMenu()
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "Help(&B)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "help(&F)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 115, "about(&Y)")
    
    Dump = SetMenu(hwnd, MenuWnd)
    PreWinProc = GetWindowLong(hwnd, GWL_WNDPROC)
    SetWindowLong hwnd, GWL_WNDPROC, AddressOf MsgProcess
End Sub


Private Sub UserForm_Terminate()
    DestroyMenu MenuWnd
    DestroyMenu PopupMenuID
    DestroyMenu PopupMenuWnd
    SetWindowLong hwnd, GWL_WNDPROC, PreWinProc
End Sub

模块代码

'--------------------------------------------------------
'  Forms
'->Module
'  ClassModules
'--------------------------------------------------------
Public PreWinProc As Long, hwnd As Long

Public Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Const MF_UNCHECKED = &H0&
Public Const MF_CHECKED = &H8&
Public Const MF_DISABLED = &H2&
Public Const MF_GRAYED = &H1&
Public Const MF_ENABLED = &H0&

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
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Const MF_BYCOMMAND = &H0&



Public Function MsgProcess(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim SubMenu_hWnd As Long
    Select Case wParam
        Case 100
            MsgBox "YourChoose: Save Button"
        Case 101
            MsgBox "YourChoose: Backup Buttion"
        Case 102
            Unload UserForm1
        Case 110
            MsgBox "YourChoose: Record Button"
        Case 111
            MsgBox "YourChoose: Review Button"
        Case 112
            MsgBox "YourChoose: Tuninghelper Button"
        Case 113
            MsgBox "YourChoose: Kgthelper Button"
        Case 114
            MsgBox "YourChoose: help Button"
        Case 115
            MsgBox "YourChoose: about Button"
        Case Else
            MsgProcess = CallWindowProc(PreWinProc, hwnd, Msg, wParam, lParam)
    End Select
End Function