VBA 窗體中添加菜單


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(PopupMenuID, MF_STRING, 100, "打開(&O)...")
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "文件(&F)")
    
    PopupMenuWnd = CreatePopupMenu()
    
    Dump = AppendMenu(PopupMenuWnd, MF_STRING, 101, "這是一個菜單和文本框結合的例子")
    Dump = AppendMenu(PopupMenuWnd, MF_STRING, 102, "點擊一個菜單項,就可以把")
    Dump = AppendMenu(PopupMenuWnd, MF_STRING, 103, "此子菜單里的內容輸入到文本框中")
    Dump = AppendMenu(PopupMenuID, MF_POPUP, PopupMenuWnd, "輸入內容到文本框")
    
    Dump = AppendMenu(PopupMenuID, MF_SEPARATOR, 109, "")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 200, "1.使2有效")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 201, "2.使1有效")
    EnableMenuItem PopupMenuID, 201, MF_BYCOMMAND Or MF_GRAYED Or MF_DISABLED
    
    Dump = AppendMenu(PopupMenuID, MF_SEPARATOR, 111, "")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 108, "退出(&X)")
    
    PopupMenuID = CreatePopupMenu()
    
    Dump = AppendMenu(PopupMenuID, MF_STRING, 104, "剪切(&T)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 105, "復制(&C)")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 106, "粘貼(&P)")
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "編輯(&E)")
    
    PopupMenuID = CreatePopupMenu()
    
    Dump = AppendMenu(PopupMenuID, MF_STRING, 110, "選項一")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 111, "選項二")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 112, "選項三")
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "圓按鈕(&R)")
    Dump = CheckMenuRadioItem(PopupMenuID, 110, 112, 110, MF_BYCOMMAND)
    
    PopupMenuID = CreatePopupMenu()
    
    Dump = AppendMenu(PopupMenuID, MF_STRING, 113, "選項一")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "選項二")
    Dump = AppendMenu(PopupMenuID, MF_STRING, 115, "選項三")
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "選擇按鈕(&C)")
    Dump = CheckMenuItem(PopupMenuID, 113, MF_BYCOMMAND Or MF_CHECKED)
    
    PopupMenuID = CreatePopupMenu()
    
    Dump = AppendMenu(PopupMenuID, MF_STRING, 107, "關於(&A)...")
    Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "幫助(&H)")
    
    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

摘自:http://club.excelhome.net/thread-480017-1-1.html,感謝大佬的付出!


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM