自定义Excel菜单栏技术——表驱动命令栏
在Excel中采用表驱动(table-driven)的方式创建自定义命令栏是一种常用的技术。即在工作表中设置适当的数据，然后利用这些数据来创建菜单，这样既简单又方便。而且，不懂VBA编程的用户也能通过修改工作表中的数据来创建自已的命令栏。
这里介绍一个相对简单的例子，来自于《Mastering Excel 2003 Programming with VBA》。如下图所示的工作表中放置用来创建菜单的数据：
现在，需要使用程序来运用MenuBuilder工作表来构建适当的菜单，除了ParentTag列（即A列）外，其他列为CommandBarControl对象的不同属性。ParentTag列用来指定是否创建一个新的菜单、菜单项或子菜单。代码如下：
Const NA = "N/A"
'列偏移
Const TAG_OFFSET = 1
Const CAPTION_OFFSET = 2
Const TYPE_OFFSET = 3
Const ONACTION_OFFSET = 4
Const BEGINGROUP_OFFSET = 5
Const DESCRIPTION_OFFSET = 6
Sub BuildMenu()
Dim ws As Worksheet
Dim rg As Range
On Error GoTo ErrHandler
Set ws = ThisWorkbook.Worksheets("MenuBuilder")
'从第二行开始,因为第一行已经包含了列标题
Set rg = ws.Cells(2, 1)
Do Until IsEmpty(rg)
If rg.Value = NA Then
'新建顶级菜单项
AddTopLevelItem rg
Else
'现有控件的子菜单
AddSubItem rg
End If
'向下移一行
Set rg = rg.Offset(1, 0)
Loop
ExitPoint:
Set rg = Nothing
Set ws = Nothing
Exit Sub
ErrHandler:
Debug.Print Err.Description
Resume ExitPoint
End Sub
'向工作表菜单栏中添加新菜单项
Private Function AddTopLevelItem(rg As Range) As CommandBarControl
Dim cbWSMenuBar As CommandBar
Dim cbc As CommandBarControl
On Error GoTo ErrHandler
Set cbWSMenuBar = Application.CommandBars("Worksheet Menu Bar")
'添加菜单项
Set cbc = cbWSMenuBar.Controls.Add(msoControlPopup, , , , True)
cbc.Tag = rg.Offset(0, TAG_OFFSET).Value
cbc.DescriptionText = rg.Offset(0, DESCRIPTION_OFFSET).Value
cbc.Caption = rg.Offset(0, CAPTION_OFFSET).Value
'返回新添加的菜单项
Set AddTopLevelItem = cbc
ExitPoint:
Set cbc = Nothing
Set cbWSMenuBar = Nothing
Exit Function
ErrHandler:
Set AddTopLevelItem = Nothing
Resume ExitPoint
End Function
Private Function AddSubItem(rg As Range) As CommandBarControl
Dim cbcParent As CommandBarControl
Dim cbc As CommandBarControl
On Error GoTo ErrHandler
'基于父标记定位父菜单
Set cbcParent = Application.CommandBars.FindControl(, , rg.Value)
If Not cbcParent Is Nothing Then
'添加菜单项
Set cbc = cbcParent.Controls.Add(GetType(rg))
'确保该菜单项具有一个OnAction值而不是N/A
If rg.Offset(0, ONACTION_OFFSET).Value <> NA Then
cbc.OnAction = rg.Offset(0, ONACTION_OFFSET).Value
End If
cbc.Tag = rg.Offset(0, TAG_OFFSET).Value
cbc.DescriptionText = rg.Offset(0, DESCRIPTION_OFFSET).Value
cbc.Caption = rg.Offset(0, CAPTION_OFFSET).Value
cbc.BeginGroup = rg.Offset(0, BEGINGROUP_OFFSET).Value
'返回新添加的控件
Set AddSubItem = cbc
Else
'不能找到父控件-返回无
Set AddSubItem = Nothing
End If
ExitPoint:
Set cbc = Nothing
Set cbcParent = Nothing
Exit Function
ErrHandler:
Debug.Print Err.Description
Set AddSubItem = Nothing
Resume ExitPoint
End Function
'将所选的msoControlType枚举转换为值
Private Function GetType(rg As Range) As Long
Dim sType As String
sType = rg.Offset(0, TYPE_OFFSET).Value
Select Case sType
Case Is = "msoControlPopup"
GetType = msoControlPopup
Case Is = "msoControlButton"
GetType = msoControlButton
Case Is = "msoControlDropDown"
GetType = msoControlDropdown
Case Else '包括N/A
'默认为msoControlPopup
GetType = msoControlPopup
End Select
End Function
'删除标记为"MyMenu2"的控件
Sub DeleteMyMenu2()
DeleteMenu "MyMenu2"
End Sub
'删除标记为"MyMenu3"的控件
Sub DeleteMyMenu3()
DeleteMenu "MyMenu3"
End Sub
Private Sub DeleteMenu(sTag As String)
Dim cbc As CommandBarControl
Set cbc = Application.CommandBars.FindControl(Tag:=sTag)
If Not cbc Is Nothing Then
cbc.Delete
End If
Set cbc = Nothing
End Sub
上述代码的主程序是BuildMenu过程，该过程遍历工作表MenuBuilder中A列的单元格，检查其值是否等于N/A，如果等于则调用AddTopLevelItem过程在工作表菜单栏中创建一个新菜单项，如果不等于则调用AddSubItem过程，根据标记查找已存在的菜单项并在其中添加子菜单项。
此外，AddTopLevelItem过程忽略了Type列和OnAction列，并自动添加msoControlPopup类型的控件。AddSubItem过程将检查OnAction列的值，确保其中不会包含值N/A，若包含则不会设置OnAction属性。
最后的三个过程用来删除已创建好的菜单项。
创建的菜单如下图。
前面说过，这是一个简单的菜单构建器示例，其中只包括了构建菜单所需的常见的一些属性。您可以添加列并修改相应的代码，使其功能更加强大，例如添加控件的Visible和Enabled属性列。
