在用户窗体上添加菜单.doc

技巧1 在用户窗体上添加菜单在VBA中，用户窗体上是没有菜单的，为了使用方便，我们可以使用API函数在用户窗体上添加菜单，示例代码如下：#001 Private Declare Function FindWindow Lib user32 Alias FindWindowA (ByVal lpClassName As String, ByVal lpWindowName As String) As Long#002 Private Declare Function SetMenu Lib user32 (ByVal hwnd As Long, ByVal hMenu As Long) As Long#003 Private Declare Function CreateMenu Lib user32 () As Long#004 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#005 Private Declare Function DestroyMenu Lib user32 (ByVal hMenu As Long) As Long#006 Private Declare Function CreatePopupMenu Lib user32 () As Long#007 Private Declare Function SetWindowLong Lib user32 Alias SetWindowLongA (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long#008 Private Declare Function GetWindowLong Lib user32 Alias GetWindowLongA (ByVal hwnd As Long, ByVal nIndex As Long) As Long#009 Private Const GWL_WNDPROC = (-4)#010 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#014 Private Sub UserForm_Initialize()#015 If Val(Application.Version) 9 Then#016 hwnd = FindWindow(ThunderXFrame, Me.Caption)#017 Else#018 hwnd = FindWindow(ThunderDFrame, Me.Caption)#019 End If#020 MenuWnd = CreateMenu()#021 PopupMenuID = CreatePopupMenu()#022 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, 系统设置(&X)#023 Dump = AppendMenu(PopupMenuID, MF_STRING, 100, 保存(&S).)#024 Dump = AppendMenu(PopupMenuID, MF_STRING, 101, 备份(&E)#025 Dump = AppendMenu(PopupMenuID, MF_STRING, 102, 退出(&X)#026 PopupMenuID = CreatePopupMenu()#027 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, 会计凭证(&P)#028 Dump = AppendMenu(PopupMenuID, MF_STRING, 110, 录入(&L)#029 Dump = AppendMenu(PopupMenuID, MF_STRING, 111, 审核(&C)#030 PopupMenuID = CreatePopupMenu()#031 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, 会计账簿(&Z)#032 Dump = AppendMenu(PopupMenuID, MF_STRING, 112, 记账(&T)#033 Dump = AppendMenu(PopupMenuID, MF_STRING, 113, 结账(&J)#034 PopupMenuID = CreatePopupMenu()#035 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, 会计报表(&B)#036 Dump = AppendMenu(PopupMenuID, MF_STRING, 114, 资产负债表(&F)#037 Dump = AppendMenu(PopupMenuID, MF_STRING, 115, 损益表(&Y)#038 Dump = SetMenu(hwnd, MenuWnd)#039 PreWinProc = GetWindowLong(hwnd, GWL_WNDPROC)#040 SetWindowLong hwnd, GWL_WNDPROC, AddressOf MsgProcess#041 End Sub#042 Private Sub UserForm_Terminate()#043 DestroyMenu MenuWnd#044 DestroyMenu PopupMenuID#045 DestroyMenu PopupMenuWnd#046 SetWindowLong hwnd, GWL_WNDPROC, PreWinProc#047 End Sub代码解析：第1行到第13行代码，API函数声明。第14行到第41代码，用户窗体的Initialize事件过程，在窗体显示时使用API函数在窗体上添加菜单。其中第22行代码添加第一个“系统设置”菜单，第23、24、25行代码在“系统设置”菜单中添加三个子菜单，第26行代码往下继续添加其他菜单。第40行代码，为窗体中添加的菜单指定所执行的过程名称为“MsgProcess”函数过程。第42行到第47行代码，用户窗体的Terminate事件过程，将所有引用对象的变量设置成Nothing，从而删除对象的所有引用。为了能够使用窗体中添加的菜单，需要在模块中写入下面的代码：#001 Public PreWinProc As Long, hwnd As Long#002 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#003 Public Declare Function CheckMenuItem Lib user32 (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long#004 Public Declare Function EnableMenuItem Lib user32 (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long#005 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#011 Private Declare Function GetMenu Lib user32 (ByVal hwnd As Long) As Long#012 Private Declare Function GetSubMenu Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As Long#013 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#015 Dim SubMenu_hWnd As Long#016 Select Case wParam#017 Case 100#018 MsgBox 你选择的是保存按钮!#019 Case 101#020 MsgBox 你选择的是备份按钮!#021 Case 102#022 Unload UserForm1#023 Case 110#024 MsgBox 你选择的是录入按钮!#025 Case 111#026 MsgBox 你选择的是审核按钮!#027 Case 112#028 MsgBox 你选择的是记账按钮!#029 Case 113#030 MsgBox 你选择的是结账按钮!#031 Case 114#032 MsgBox 你选择的是资产负债表按钮!#033 Case 115#034 MsgBox 你选择的是损益表按钮!#035 Case Else#036 MsgProcess = CallWin