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