使用VBA自定义Excel2007快捷菜单

本文将展示一些操作Excel2007快捷菜单的VBA代码实例，您可以修改这些例子以满足您的需要。本文中的大部分内容也适用于Excel以前的版本。
重置快捷菜单
Reset方法恢复某快捷菜单到其默认状态，例如，下面的过程恢复单元格(Cell)快捷菜单到其标准状态：
Sub ResetCellMenu()
    CommandBars("Cell").Reset
End Sub

Excel2007有两个名为Cell的快捷菜单，上面的代码仅恢复第一个(即索引值为38)的Cell快捷菜单。为恢复第二个Cell快捷菜单，使用索引值(41)代替其名称。
下面的过程恢复所有的内置工具栏到其初始状态：
Sub ResetAll()
    Dim cbar As CommandBar
    For Each cbar In Application.CommandBars
        If cbar.Type = msoBarTypePopup Then
            cbar.Reset
            cbar.Enabled = True
        End If
    Next cbar
End Sub

注意，如果在您的应用程序中添加项目到某快捷菜单中，最好在关闭应用程序时分别移除这些项目。如果简单地恢复快捷菜单，将会删除由其它应用程序所定制的快捷菜单。
禁用快捷菜单
Enabled属性可以让您禁用整个快捷菜单。例如，可以设置该属性后，在右键单击某单元格时不再显示正常的快捷菜单，下面的语句禁用Cell快捷菜单：

PLAIN TEXT
Visual Basic:
Application.CommandBars("Cell").Enabled = False
要重新启用该快捷菜单，简单地设置其Enabled属性为True。
如果想要禁用所有的快捷菜单，使用下面的过程：
Sub DisableAllShortcutMenus()
    Dim cb As CommandBar
    For Each cb In CommandBars
        If cb.Type = msoBarTypePopup Then _
          cb.Enabled = False
    Next cb
End Sub
注意，禁用的快捷菜单将会在所有会话中起作用，因此，在关闭Excel之前可能想要恢复快捷菜单。要恢复快捷菜单，将前面过程中的Enabled属性设置为True。
禁用快捷菜单项
您可能想在应用程序运行时，禁用某快捷菜单中的一个或多个快捷菜单项。当禁用某菜单项时，其文本显示为亮灰色，单击它时不会有任何效果。下面的过程从行或列快捷菜单中禁用“隐藏”菜单项：
Sub DisableHideMenuItems()
    CommandBars("Column").Controls("隐藏(H)").Enabled = False
    CommandBars("Row").Controls("隐藏(H)").Enabled = False
End Sub
添加一个新项到单元格快捷菜单中
下面的AddToShortcut过程添加一个新菜单项到单元格快捷菜单中：Toggle Word Wrap。Excel有两个单元格快捷菜单，下面的过程修改正常的右击菜单，但不修改显示在分页预览模式下的右击菜单。
Sub AddToShortCut()
    '添加一个菜单项到单元格快捷菜单中
    Dim Bar As CommandBar
    Dim NewControl As CommandBarButton
    DeleteFromShortcut
    Set Bar = CommandBars("Cell")
    Set NewControl = Bar.Controls.Add _
      (Type:=msoControlButton, _
      temporary:=True)
    With NewControl
        .Caption = "Toggle &Word Wrap"
        .OnAction = "ToggleWordWrap"
        .Picture = Application.CommandBars.GetImageMso _
          ("WrapText", 16, 16)
        .Style = msoButtonIconAndCaption
    End With
End Sub

图1展示了在右击单元格后显示的新菜单项。

图1：带有自定义菜单项的单元格快捷菜单
上面的过程中，在声明了一组变量后调用DeleteFromShortcut过程(参见下面)。这条语句确保在单元格快捷菜单中仅显示一次Toggle Word Wrap菜单项，注意该菜单项带下划线的热键是W，不是T，那是因为已准备在Cut菜单项中使用T。
设置Picture属性为Wrap Text命令来引用使用在功能区中的图像，参见“”中关于在功能区命令中使用图像的更多信息。
下面的宏通过OnAction属性指定，在选择该菜单项时执行。这里，宏的名称为ToggleWordWrap：
Sub ToggleWordWrap()
    CommandBars.ExecuteMso ("WrapText")
End Sub
这个过程简单地执行功能区中的“自动换行”命令。
注意，在修改快捷菜单后，所作的修改将一直保留。换句话说，所修改的快捷菜单在关闭包含该VBA代码的工作簿时不会自已恢复。因此，如果编写代码来修改某快捷菜单，几乎总要编写代码来恢复修改所产生的影响。
DeleteFromShortcut过程从单元格快捷菜单中删除新的菜单项。
Sub DeleteFromShortcut()
    On Error Resume Next
    CommandBars("Cell").Controls _
      ("Toggle &Word Wrap").Delete
End Sub

在一些情况下，想要自动地添加和删除增加的快捷菜单：当打开工作簿时添加快捷菜单项，在关闭工作簿时删除该菜单项。只需要将这两个事件过程添加到ThisWorkbook代码模块：
Private Sub Workbook_Open()
    Call AddToShortCut
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call DeleteFromShortcut
End Sub
Workbook_Open过程在打开工作簿时执行，Workbook_BeforeClose过程在关闭工作簿之前执行。
注意，添加到快捷菜单中的菜单项不只是在创建菜单项的工作簿可用，在所有工作簿中都是可用的。
添加子菜单到快捷菜单中
本节中的示例将添加带有三个选项的子菜单到快捷菜单中。事实上，添加了子菜单到6个快捷菜单中。图2展示右击一行之后的工作表，子菜单项中的每一个都执行一个宏，来改变所选单元格中的文本。

图2：这个快捷菜单有一个带有三个子菜单项的子菜单
--------------------------------------------
查找FaceID图像
显示在快捷菜单项中的图标由两个属性设置之一来确定：

Picture:该选项可以使用功能区中的imageMso。
FaceID:这是最容易的选项，因为FaceID属性只是一个数字值，代表几百个图像中的一个。
但是，如何查找与特定FaceID图像一致的数值呢？Excel没有提供方法，John Walkenbach创建了一个工具工作簿，可以单击此处下载，并参见“如何在Excel2007中创建自定义菜单”。您只需输入开始和结束的FaceID数字，单击按钮后，将会在工作表中显示图像。每个图像有一个与其FaceID值相一致的名称。

--------------------------------------------
下面的代码创建了子菜单及其菜单项：
Sub AddSubmenu()
'   添加一个子菜单到6个快捷菜单中
    Dim Bar As CommandBar
    Dim NewMenu As CommandBarControl
    Dim NewSubmenu As CommandBarButton
    Dim cbIndex As Long     DeleteSubMenu
    For cbIndex = 36 To 41
        Set Bar = CommandBars(cbIndex)
'       添加子菜单
        Set NewMenu = Bar.Controls.Add _
            (Type:=msoControlPopup, _
             temporary:=True)
        NewMenu.Caption = "Ch&ange Case"
        NewMenu.BeginGroup = True
'       添加第一个子菜单项
        Set NewSubmenu = NewMenu.Controls.Add _
          (Type:=msoControlButton)
        With NewSubmenu
            .FaceId = 38
            .Caption = "&Upper Case"
            .OnAction = "MakeUpperCase"
        End With
'       添加第二个子菜单项
        Set NewSubmenu = NewMenu.Controls.Add _
          (Type:=msoControlButton)
        With NewSubmenu
            .FaceId = 40
            .Caption = "&Lower Case"
            .OnAction = "MakeLowerCase"
        End With
'       添加第三个子菜单项
        Set NewSubmenu = NewMenu.Controls.Add _
          (Type:=msoControlButton)
        With NewSubmenu
            .FaceId = 476
            .Caption = "&Proper Case"
            .OnAction = "MakeProperCase"
        End With
    Next cbIndex
End Sub

AddSubmenu过程使用了一个循环来修改索引值在36和41之间的6个CommandBar对象。所添加的子菜单，其Type属性是msoControlPopup，然后添加了三个子菜单项，每一个子菜单项都有一个不同的OnAction属性。
所调用的DeleteSubMenu过程为：
Sub DeleteSubMenu()
    On Error Resume Next
    Dim Bar As CommandBar
    Dim NewMenu As CommandBarControl
    Dim cbIndex As Long    For cbIndex = 36 To 41
        Set Bar = CommandBars(cbIndex)
'       删除子菜单
      Bar.Controls _
        ("Ch&ange Case").Delete
    Next cbIndex
End Sub