2007基础:自定义菜单技术(2)
在Excel 97至Excel 2003等版本中,可以利用“自定义”对话框来创建新菜单,并建立菜单项,但很难创建子菜单。因此,特定的工作簿菜单必须编写代码来创建。下面的技术介绍了使用一种相当简单的方法在工作表菜单栏中创建自定义菜单,当工作簿打开时则显示自定义的菜单,该工作簿关闭时则删除自定义的菜单。
先来看看一个示例,该示例演示了这项技术。
示例文件包含了所有需要创建自定义菜单的VBA代码,在大多数情况下,不需要改变这些代码,只需按自已的意图简单地自定义MenuSheet工作表即可。VBA代码清单如下:
Sub CreateMenu()
' 当工作簿打开时本过程自动执行.
' 注:在这个子过程中没有错误处理语句.
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''''
' 获取菜单的位置
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
' 确保菜单不重复
Call DeleteMenu
' 行初始值
Row = 2
' 使用MenuSheet工作表中的数据添加菜单,菜单项和子菜单项
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With
Select Case MenuLevel
Case 1 '代表菜单
' 添加顶级菜单到工作表菜单栏中
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
Case 2' 代表菜单项
If NextLevel = 3 Then
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId <> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True
Case 3 ' 代表子菜单项
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End Sub
Sub DeleteMenu()
' 这个子过程在工作簿关闭时执行
' 删除自定义菜单
Dim MenuSheet As Worksheet
Dim Row As Integer
Dim Caption As String
On Error Resume Next
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
Row = 2
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
If MenuSheet.Cells(Row, 1) = 1 Then
Caption = MenuSheet.Cells(Row, 2)
Application.CommandBars(1).Controls(Caption).Delete
End If
Row = Row + 1
Loop
On Error GoTo 0
End Sub
Sub DummyMacro()
MsgBox "您可以在本过程中添加相应的操作代码."
End Sub
换句话说,该技术使用了一个存放在MenuSheet工作表中的(如下图2所示),只需按自已的需要简单地修改表中的数据,就可创建自已的菜单。
Excel 2007基础教程