2024年在Excel中创建自定义菜单并为菜单项指定宏.doc

在Excel 中创建自定义菜单并为菜单项指定宏
Excel 使用了新的用户界面，每项功效都在称作Ribbon的功效区中且它们的位置都是固定的，仅迅速访问工具栏(QAT)与先前版本的工具栏相同，可用来添加或删除命令。因此，在Excel 中创建自定义菜单并为菜单项指定宏不像在Excel 中那样轻易。本文汇总了John Walkenbach、John McLea和Ron de Bruin所简介的技术。
　　- - - -技术基础
　　—— 识别工具栏图像
　　假如使用Excel 97或以后的版本，您懂得它使用某些图像在它的内置菜单和工具栏中。您能够通过设置FaceID属性为一个特定的整数在自定义菜单和工具栏中使用这些内置图像。然而，问题是怎样懂得图像所对应的整数。
　　下面的子过程创建了一个带有开始的250个FaceID图像(见下图1所示)的自定义工具栏。创建了工具栏之后，将鼠标指针放在按钮上面来找到与图像对应的FaceID值。但单击工具栏按钮不会产生任何效果，因为子过程没有在OnAction属性中分派任何宏。当然，您能够通过变化IDStart和IDStop的值来看到更多的图像，最后一个FaceID图像显示数字3518(也有某些空白图像)。
[img][/img]

图1：创建一个FaceID工具栏，当鼠标放在某图像上时将显示对应的数字
　　下面是子过程代码：
Sub ShowFaceIDs()
　　Dim NewToolbar As CommandBar
　　Dim NewButton As CommandBarButton
　　Dim i As Integer, IDStart As Integer, IDStop As Integer

　'假如已存在FaceIds工具栏则删除
　　On Error Resume Next
　　Application.CommandBars("FaceIds").Delete
　　On Error GoTo 0

　　'添加一个空工具栏
　　Set NewToolbar = Application.CommandBars.Add _
　　　　(Name:="FaceIds", temporary:=True)
　　NewToolbar.Visible = True

　　'能够变化下面的值来看到不一样的FaceIDs
　　IDStart = 1
　　IDStop = 250

　　For i = IDStart To IDStop
　　　　Set NewButton = NewToolbar.Controls.Add _
　　　　　　(Type:=msoControlButton, ID:=2950)
　　　　NewButton.FaceId = i
　　　　NewButton.Caption = "FaceID = " & i
　　Next i
　　NewToolbar.Width = 600
End Sub
　　另外，也能够使用VBA代码在工作表中列出所有的FaceID图像和相对应的整数。该代码由John D. McLean编写，代码清单如下：
'在工作表中显示所有工具栏按钮图像/图标，由36行100列组成
'对应的最左/右列和最顶/底行中的数字相加即为该图标号
Sub DisplayButtonFacesInGrid()
　　Const cbName = "JDMTestToolBar"
　　Dim cBar As CommandBar, cBut As CommandBarControl
　　Dim r As Long, c As Integer, count As Integer
　　Application.StatusBar = "Creating Button FaceIDs ......."
　　Workbooks.Add
　　'创建四周的数字
　　For r = 0 To 35
　　　Cells(r + 2, 1).Value = 100 * r: Cells(r + 2, 102).Value = 100 * r
　　Next r
　　For c = 0 To 99
　　　Cells(1, c + 2).Value = c: Cells(38, c + 2).Value = c
　　Next c
　　Range("A1:A38").Select
　　With Selection
　　　.Font.Bold = True
　　　.HorizontalAlignment = xlCenter
　　　.VerticalAlignment = xlCenter
　　End With
　　Range("CX1:CX38").Select
　　With Selection
　　　.Font.Bold = True
　　　.HorizontalAlignment = xlCenter
　　　.VerticalAlignment = xlCenter
　　End With
　　Range("B1:CW1").Select
　　With Selection
　　　.Font.Bold = True
　　　.HorizontalAlignment = xlCenter
　　　.VerticalAlignment = xlCenter
　　End With
　　Range("B38:CW38").Select
　　With Selection
　　　.Font.Bold = True
　　　.HorizontalAlignment = xlCenter
　　　.VerticalAlignment = xlCenter
　　End With
　　Range("E5").Select
　　Selection.Value = "Please wait .............."
　　With Selection.Font
　　　.Name = "Arial"
　　　.Size = 24
　　　.Bold = True
　　　.ColorIndex = 3
　　End With
　　Range("E5:J10").Select
　　With Selection
　　　.HorizontalAlignment = xlCenter
　　　.VerticalAlignment = xlCenter
　　　.MergeCells = True
　　End With
　　Application.ScreenUpdating = False
　　With Selection
　　　.ClearContents
　　　.UnMerge
　　End With
　　On Error Resume Next
　　CommandBars(cbName).Delete
　　On Error GoTo 0
　　Set cBar = CommandBars.Add　　'创建带有一个按钮的暂时工具栏
　　With cBar
　　　.Name = cbName
　　　.Top = 0
　　　.Left = 0
　　　.Visible = True
　　End With
　　r = 2: c = 2: count = 0　　　 '在单元格Cell(2,2)中的FaceID号为0
　　Set cBut = CommandBars(cbName).Controls.Add(Type:=msoControlButton)
　　With cBut
　　　Do　　　　　　　　　　　　　'循环所有的FaceIDs
　　　　.FaceId = count
　　　　Cells(r, c).Select　　　'分派至按钮然后复制到工作表
　　　　.CopyFace
　　　　Selection.PasteSpecial
　　　　Cells(1, 1).Copy
　　　　c = c + 1
　　　　If c >= 102 Then　　　　　'更新复制的位置
　　　　　c = 2
　　　　　r = r + 1
　　　　End If
　　　　count = count + 1
　　　Loop While count < 3519　　 '3519是最大的FaceID号
　　End With
　　Rows("1:38").RowHeight = 24.6　　　 '增大单元格尺寸
　　Columns("A:CX").ColumnWidth = 5.56
　　With ActiveSheet.DrawingObjects　　'增大按钮尺寸
　　　.ShapeRange.ScaleWidth 2#, msoFalse, msoScaleFromTopLeft
　　　.ShapeRange.ScaleHeight 2#, msoFalse, msoScaleFromTopLeft
　　　.ShapeRange.IncrementLeft 8.4
　　　.ShapeRange.IncrementTop 3#
　　End With
　　Range(Cells(2, 2), Cells(37, 101)).Select　'格式化网格线和背景
　　With Selection
　　　With .Interior
　　　　.ColorIndex = 15
　　　　.Pattern = xlSolid
　　　End With
　　　With .Borders(xlInsideVertical)
　　　　.LineStyle = xlContinuous
　　　　.Weight = xlThin
　　　　.ColorIndex = 2
　　　End With
　　　With .Borders(xlInsideHorizontal)
　　　　.LineStyle = xlContinuous
　　　　.Weight = xlThin
　　　　.ColorIndex = 2
　　　End With
　　End With
　　 '恢复Excel设置
　　CommandBars(cbName).Delete
　　On Error GoTo 0
　　Range("A1").Select
　　Application.ScreenUpdating = True
　　Application.StatusBar = ""
　　End Sub
运行上面的代码后，将新建一个工作簿，并在该工作簿内列出所有的内置图标图像，最左列、最右列、最顶部、最底部为对应的数字，将某图标对应的最左(或右)列的数字与最顶一行(或最底一行)的数字相加，即为该图标对应的数字。
(注：上面的代码运行较慢，需耐心等候。)
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
在Excel 97至Excel 等版本中，能够利用“自定义”对话框来创建新菜单，并建立菜单项，但极难创建子菜单。因此，特定的工作簿菜单必须编写VBA代码来创建。下面的技术简介了使用一个相称简单的措施在工作表菜单栏中创建自定义菜单，当工作簿打开时则显示自定义的菜单，该工作簿关闭时则删除自定义的菜单。
　　先来看看一个示例，该示例演示了这项技术。
　　示例文献包括了所有需要创建自定义菜单的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所示)，只需按自已的需要简单地修改表中的数据，就可创建自已的菜单。
[img][/img]

图2：存储菜单项的表格
　　该表格包括5列：
　　(1) 级别：指定的菜单项的级别，有效值是1、2、3。第1级别是菜单，第2级别是菜单项，第3级别是子菜单项。正常情况下，有一个第1级别的菜单，下面包括有第2级别的菜单项。一个第2级别的菜单项也许包括或不包括有第3级别的菜单项(子菜单项)。
　　(2) 标题：显示在菜单、菜单项和子菜单项中的文字。使用连接符(&)指定一个带下划线的字符。
　　(3) 位置/宏：对于第1级菜单，应当是一个整数，代表菜单在菜单栏中的位置。对于第2级或第3级菜单项，应当是一个宏，当该菜单项被选择时执行对应的宏。假如第2级菜单项有一个或多个第3级菜单项，第2级菜单项也许没有一个宏与它有关联。
　　(4) 分隔线：假如设置为真，将在菜单项或子菜单项前放置一个分隔线。
　　(5) FaceID(图标号)：可选的。一个代码数字，代表显示在菜单项前内置的图形图像。获取代码数字可见上文所简介的识别工具栏图像的内容。
　　下图3显示了使用上面的表格所创建的自定义菜单。
[img][/img]

图3：一个自定义菜单的例子
　　要在工作簿或者加载宏中使用这项技术，能够按照下面的步骤进行：
　　(1) 打开前面下载的工作簿文献。该工作簿包括有VBA代码和一个名为MenuSheet的工作表。
　　(2) 将该工作簿中的所有代码复制到自已的VBA工程的模块中。
　　(3) 将下面的子过程添加到ThisWorkbook对象模块中：
Private Sub Workbook_Open()
　　Call CreateMenu
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Call DeleteMenu
End Sub　　

　　(4) 当工作簿打开时，执行Workbook_Open子过程，当工作簿关闭时，执行Workbook_BeforeClose子过程。
　　(5) 插入一个新工作表并命名为MenuSheet。然后直接复制menumakr.xls文献中的表格到MenuSheet工作表中。
　　(6) 按自已的需要修改MenuSheet工作表中的表格。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
　　下面的内容应用了前面所讲的技术在Excel 中创建自定义菜单，并为菜单项指定对应的宏，如图4所示。
[img][/img]

图4：在Excel 中自定义菜单示例
——只用于一个工作簿 
　　能够按下面的步骤在特定的Excel 工作簿中创建自定义菜单：
在Excel 中打开该工作簿。
　　 在迅速访问工具栏(QAT)中单击右键，选择“自定义迅速访问工具栏”，弹出“Excel 选项”对话框。在对话框中的“从下列位置选择命令”下拉列表框中选择“宏”，然后在右侧的“自定义迅速访问工具栏”下拉列表框中选择“用于MyWorkbook.xlsm”。
　　然后，在左侧的列表框中选择“WBDisplayPopUp”，单击“添加”按钮，再单击“确定”按钮。
　　假如想修改所要显示的图标，可单击下方的“修改”按钮。
[img][/img]

图5：在“Excel选项”中添加自定义菜单
　　(4) 此时，迅速访问工具栏中新增了一个图标，点击该图标将弹出自定义菜单。能使用Ctrl+M组合键迅速打开菜单，也能使用“宏”对话框(按Alt+F8键)修改快捷键。
　　其实，在示例工作簿中隐藏着一个工作表，该工作表上存储着菜单项名称、所执行的宏名及图标号等。能够在任一工作表标签中单击右键，选择“取消隐藏”命令，或在“开始”功效区中选择“格式”下的隐藏/取消隐藏”中对应的命令来显示该工作表。该工作表如图6所示。

图6：存储菜单项名、宏名及图标号的MenuSheet工作表
　　与前面所讲述的内容同样，该工作表中包括5列，分别为：
　　(1)级别：指定的菜单项的级别，有效值是2和3。第2级别是菜单项，第3级别是子菜单项。
　　(2) 标题：显示在菜单、菜单项和子菜单项中的文字。使用连接符(&)指定一个带下划线的字符。
　　(3) 宏：对于第2级或第3级菜单项，应当是一个宏，当该菜单项被选择时执行对应的宏。假如第2级菜单项有一个或多个第3级菜单项，第2级菜单项也许没有一个宏与它有关联。能够按Alt+F11键进入VBE窗口，在宏模块中添加或修改宏。
　　(4) 分隔线：假如设置为真，将在菜单项或子菜单项前放置一个分隔线。
　　(5) FaceID(图标号)：可选的。一个代码数字，代表显示在菜单项前内置的图形图像。获取代码数字可见上文所简介的识别工具栏图像的内容，也可见下文的简介。
　　能够修改MenuSheet工作表中的内容，然后按“刷新菜单”按钮来变化菜单项。单击“隐藏菜单工作表”按钮将隐藏MenuSheet工作表。
　　示例代码见示例工作簿。查找图标号的示例工作簿请点击此处下载(show faceids.xlsm)，在工作表的First ID和Last ID单元格框中输入起始和终止数字，单击“GO按钮，在下方显示对应数量的图标，单击任一图标，名称框中将显示其ID编号。
　　- - - - - - - - - - - - - - - - - - - -
——用于所有工作簿 
　　假如想在所有工作簿中都能够使用指定宏，则能够将宏复制到Personal.xlsb中或者使用隐藏在XLStart文献夹下的xlsb工作簿。该文献夹中的每个文献都会在Excel开启时自动打开。另一个措施是创建带有宏的加载项。
　　XLStart文献夹位于所安装的Office目录下，详细途径取决于您所安装的Office的位置。
　　示例图片如上文图4所示。
　　(1) 点此下载文献MyMacroFile.xlsb。
　　(2) 复制该文献至XLStart文献夹中，然后打开Excel。
　　(3) 在迅速访问工具栏(QAT)中右击，选择“自定义迅速访问工具栏”，弹出如图7所示的对话框。在“从下列位置选择命令”下拉列表框中选择“宏”，“自定义迅速访问工具栏”中选择“用于所有文档(默认)”。选择“DisplayPopUp”宏，按“添加”按钮，然后单击“确定”按钮。(当然，您也能够先单击“修改”按钮选择您喜欢的图标)
[img][/img]

图7：“Excel选项”对话框
　　(4) 此时，迅速访问工具栏中新增了一个图标，点击该图标将弹出自定义菜单。
　　能够在“视图”功效区中单击“取消隐藏”命令来显示MenuSheet工作表。该工作表含有5列，与图6相同且其含义同上文所述。