VBA常用代码解析（第四十一讲）

148 在用户窗体上添加菜单

在VBA中，用户窗体上是没有菜单的，为了使用方便，我们可以使用API函数在用户窗体上添加菜单，示例代码如下：

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 wIDNewItemAs 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 dwNewLongAs 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，PopupMenuIDAs 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)

EndIf

MenuWnd= CreateMenu()

PopupMenuID= CreatePopupMenu()

Dump= AppendMenu(MenuWnd，MF_STRING + MF_POPUP，PopupMenuID，'系统设置(&X)')

Dump= AppendMenu(PopupMenuID，MF_STRING，100，'保存(&S)...')

Dump= AppendMenu(PopupMenuID，MF_STRING，101，'备份(&E)')

Dump= AppendMenu(PopupMenuID，MF_STRING，102，'退出(&X)')

PopupMenuID= CreatePopupMenu()

Dump= AppendMenu(MenuWnd，MF_STRING + MF_POPUP，PopupMenuID，'会计凭证(&P)')

Dump= AppendMenu(PopupMenuID，MF_STRING，110，'录入(&L)')

Dump= AppendMenu(PopupMenuID，MF_STRING，111，'审核(&C)')

PopupMenuID= CreatePopupMenu()

Dump= AppendMenu(MenuWnd，MF_STRING + MF_POPUP，PopupMenuID，'会计账簿(&Z)')

Dump= AppendMenu(PopupMenuID，MF_STRING，112，'记账(&T)')

Dump= AppendMenu(PopupMenuID，MF_STRING，113，'结账(&J)')

PopupMenuID= CreatePopupMenu()

Dump= AppendMenu(MenuWnd，MF_STRING + MF_POPUP，PopupMenuID，'会计报表(&B)')

Dump= AppendMenu(PopupMenuID，MF_STRING，114，'资产负债表(&F)')

Dump= AppendMenu(PopupMenuID，MF_STRING，115，'损益表(&Y)')

Dump= SetMenu(hwnd，MenuWnd)

PreWinProc= GetWindowLong(hwnd，GWL_WNDPROC)

SetWindowLonghwnd，GWL_WNDPROC，AddressOf MsgProcess

End Sub

Private Sub UserForm_Terminate()

DestroyMenuMenuWnd

DestroyMenuPopupMenuID

DestroyMenuPopupMenuWnd

SetWindowLonghwnd，GWL_WNDPROC，PreWinProc

End Sub

代码解析：

第1行到第13行代码，API函数声明。

第14行到第41代码，用户窗体的Initialize事件过程，在窗体显示时使用API函数在窗体上添加菜单。其中第22行代码添加第一个“系统设置”菜单，第23、24、25行代码在“系统设置”菜单中添加三个子菜单，第26行代码往下继续添加其他菜单。

第40行代码，为窗体中添加的菜单指定所执行的过程名称为“MsgProcess”函数过程。

第42行到第47行代码，用户窗体的Terminate事件过程，将所有引用对象的变量设置成Nothing，从而删除对象的所有引用。为了能够使用窗体中添加的菜单，需要在模块中写入下面的代码：

Public PreWinProc As Long，hwnd As Long

Public Declare Function CheckMenuRadioItem Lib'user32' (ByVal hMenu As Long，ByVal un1 AsLong，ByVal un2 As Long，ByVal un3 As Long，ByVal un4 AsLong) As Long

Public Declare Function CheckMenuItem Lib'user32' (ByVal hMenu As Long，ByVal wIDCheckItemAs Long，ByVal wCheck As Long) As Long

Public Declare Function EnableMenuItem Lib'user32' (ByVal hMenu As Long，ByVal wIDEnableItemAs 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 AsLong，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 AsLong) As Long

Private Const MF_BYCOMMAND = &H0&

Public Function MsgProcess(ByVal hwnd As Long，ByVal Msg As Long，ByVal wParamAs Long，ByVal lParam As Long) As Long

DimSubMenu_hWnd As Long

SelectCase wParam

Case 100

MsgBox '你选择的是”“保存”“按钮!'

Case 101

MsgBox '你选择的是”“备份”“按钮!'

Case 102

Unload UserForm1

Case 110

MsgBox '你选择的是”“录入”“按钮!'

Case 111

MsgBox '你选择的是”“审核”“按钮!'

Case 112

MsgBox '你选择的是”“记账”“按钮!'

Case 113

MsgBox '你选择的是”“结账”“按钮!'

Case 114

MsgBox '你选择的是”“资产负债表”“按钮!'

Case 115

MsgBox '你选择的是”“损益表”“按钮!'

Case Else

MsgProcess = CallWindowProc(PreWinProc，hwnd，Msg，wParam，lParam)

EndSelect

End Function

代码解析：

第1行到第13行代码，API函数声明。

第14行到第36行代码，MsgProcess函数过程，根据参数wParam的值为窗体中的菜单指定所执行的操作，为了演示方便只使用MsgBox函数显示一个消息框，在实际应用中可以为菜单写入代码或指定过程名称。运行窗体后在窗体上添加菜单。

▲149 在用户窗体上添加工具栏

在▲148 中我们在用户窗体上使用API函数添加了菜单，还可以在用户窗体上继续添加工具栏用以显示一列下拉菜单的位图按钮，单击一个工具栏按钮等于选择一个菜单命令，以提供对常用功能和命令的快速访问。

在用户窗体上添加工具栏可以使用Toolbar控件，在设计模式下右键单击“工具箱”，在显示的右键菜单中选择“附加控件”，在显示的对话框中选择“Microsoft Toolbar Control，veision 6.0”控件，在用户窗体上添加一个Toolbar控件。。

因为需要在Toolbar控件按钮中使用图标，所以还需要在用户窗体中添加一个ImageList控件保存所需要的图像文件，在ImageList控件的属性页中插入6张图片。

用户窗体上添加了Toolbar控件后还需要设置其属性和添加按钮控件，可以在Toolbar控件的属性页中进行设置和添加，如所图示。还可以在代码运行时对其进行设置和添加按钮，双击用户窗体写入下面的代码：

Private Sub UserForm_Initialize()

……使用API函数添加菜单代码略，详见附件

Dimarr As Variant

Dimi As Byte

arr= Array(' 录入 '，' 审核'，' 记账 '，' 结账 '，'负债表'，'损益表')

WithToolbar1

.ImageList = ImageList1

.Appearance = ccFlat

.BorderStyle = ccNone

.TextAlignment = tbrTextAlignBottom

With .Buttons

.Add(1，，““).Style = tbrPlaceholder

For i = 0 To UBound(arr)

.Add(i + 2，，，，i + 1).Caption = arr(i)

Next

End With

EndWith

End Sub

代码解析：

第5行代码数组arr用来保存按钮的标题文字。

第7行代码建立Toolbar控件和ImageList控件的关联。

第8行代码设置Toolbar控件的外观效果，Appearance属性获得或设置控件的外观效果，设置值如表格所示。

第9行代码设置Toolbar控件的边界样式，BorderStyle属性获得或设置边界样式，设置值如表格所示。

第10行代码设置按钮文本显示在按钮图像下方，TextAlignment属性获得或设置一个值，决定按钮文本显示在按钮图像下方还是右侧，设置值如表格所示。

第11行到第15行代码在Toolbar控件中添加按钮，添加按钮需要在Buttons的集合对象中使用Add方法，语法如下：

object.Buttons.Add(index，key，caption，style，image)

参数object是必需的，代表Toolbar对象。

参数index是可选的，指定新增按钮的索引值，该索引值决定了按钮在Toolbar控件中的位置。如果省略index参数新增按钮添加到Butons集合的最后。

参数key是可选的，指定新增按钮的关键字。

参数caption是可选的，指定新增按钮的标题文本。

参数style是可选的，指定新增按钮的Style属性，设置值如表格所示。

参数image是可选的，指定新增按钮载入的图像，图像必须是与该Toolbar控件相关联的ImageList控件图像库中的一个。image参数可以是一个整数，对应ImageList图像库中某个图片的Index值也可以是一个字符串，对应图片的关键字Key。

第12行代码代码首先在Toolbar控件中添加占位按钮，设置其style属性为tbrPlaceholder，添加的就是占位按钮，在Toolbar控件中是不显示的，仅仅起到占位的作用。

第14行代码在占位按钮后继续添加6个按钮，设置其标题文本和图像在ImageList控件中的编号。

为了响应Toolbar控件，双击Toolbar控件写入下面的代码：

Private Sub Toolbar1_ButtonClick(ByVal ButtonAs MSComctlLib.Button)

SelectCase Button.Index

Case 2

MsgBox '录入'

Case 3

MsgBox '审核'

Case 4

MsgBox '记账'

Case 5

MsgBox '结账'

Case 6

MsgBox '资产负债表'

Case 7

MsgBox '损益表'

EndSelect

End Sub

代码解析：

Toolbar控件的ButtonClick事件，在单击Toolbar控件的按钮时发生，参数Button代表单击的按钮。为了演示方便，根据其Index属性值使用消息框显示按钮标题文本，在实际应用中可以为菜单写入代码或指定过程名称。