在Excel中自定义上下文菜单（下）

excelperfect

标签：VBA，用户界面

本文接上两篇文章：

在Excel中自定义上下文菜单（上）

在Excel中自定义上下文菜单（中）

上下文菜单技术和技巧

下面的内容展示了如何修改本文中提供的代码，以使过程更具灵活性。

在本文开头的VBA示例中，你看到了如何通过使用工作簿的Activate和Deactivate事件调用宏来创建和删除菜单控件，从而来更改单元格上下文菜单。

可以修改下面示例中的Activate事件，为不同的用户创建不同的菜单，以便为每个用户创建具有不同自定义控件集的菜单。

Private Sub Workbook_Activate()

    Dim sUserName As String

    sUserName = Application.UserName

    Select Case sUserName

    Case '完美Excel': Call AddToCellMenu

    Case 'MyBaby': Call AddToCellMenu2

    Case Else: Call AddToCellMenu3

    End Select

End Sub

另一个例子是在Activate事件中检查Excel中的区域语言，以便可以使用用户的语言在上下文菜单中创建菜单标题。在下面的示例中，如果荷兰或德国用户打开工作簿，则会根据用户计算机的区域语言设置调用不同的宏。

Private Sub Workbook_Activate()

    Dim LangID As Long

    LangID = Application.International(xlCountryCode)

    Select Case LangID

    Case 31: Call AddToCellMenuInDutch

    Case 49: Call AddToCellMenuinGerman

    Case Else: Call AddToCellMenu

    End Select

End Sub

下面的VBA语句显示了如何在单元格上下文菜单中启用和禁用插入批注控件：

Application.CommandBars(“Cell”).FindControl(ID:=2031).Enabled =False

还可以使用下面的宏将ID添加到标题中。记住，单元格上下文菜单在每个版本的Excel中不完全相同。

Sub Add_ID_To_ContextMenu_Caption()

    ' 添加Id到上下文菜单控件的标题.

    Dim ctl As CommandBarControl

    For Each ctl In Application.CommandBars('Cell').Controls

        On Error Resume Next

        ctl.Caption = ctl.ID & ' ::: ' & ctl.Caption

        On Error GoTo 0

    Next ctl

End Sub

Sub Reset_ContextMenu()

    ' 删除上下文菜单控件标的Id.

    Dim ctl As CommandBarControl

    Dim myPos As Long

    For Each ctl In Application.CommandBars('Cell').Controls

        myPos = InStr(1, ctl.Caption, ' ::: ', vbTextCompare)

        If myPos > 0 Then

            ctl.Caption = Mid(ctl.Caption, myPos + 4)

        End If

    Next ctl

End Sub

Sub Reset_ContextMenu_To_Factory_Defaults()

    Application.CommandBars('Cell').Reset

End Sub

可以使用前面讲述的Activate和Deactivate事件来禁用和启用控件。

要使用RibbonX禁用单元格上下文菜单中的删除控件，使用RibbonX，将语句：

<button idMso=”CellsDelete” enabled=”false” />

添加到前面XML中的contextMenu控件。

正如在这条语句中所看到的，要禁用上下文菜单上的控件，必须知道该控件的ID（idMso）。然而，这可能是一个问题，因为这些信息并不适用于特定上下文菜单上的每个控件。例如，单元格、行和列上下文菜单就是如此。RibbonX中似乎没有支持的控件ID列表。可以通过使用VBA代码禁用与上一节中所述类似的特定控件来使用变通方法。

那么，如何找到要更改的其他上下文菜单的名称呢？下面的宏在每个上下文菜单的底部添加了一个带有菜单名称的按钮。

Sub Add_Name_To_Contextmenus()

    Dim Cbar As CommandBar

    For Each Cbar In Application.CommandBars

        With Cbar

            If .Type = msoBarTypePopup Then

                On Error Resume Next

                With    .Controls.Add(Type:=msoControlButton)

                    .Caption = 'Name for VBA = ' & Cbar.Name

                    .Tag = 'NameButtonInContextMenu'

                End With

                On Error GoTo 0

            End If

        End With

    Next

End Sub

Sub Delete_Name_From_Contextmenus()

    Dim Cbar As CommandBar

    Dim ctrl As CommandBarControl

    For Each Cbar In Application.CommandBars

        With Cbar

            If .Type = msoBarTypePopup Then

                For Each ctrl In .Controls

                    If ctrl.Tag = 'NameButtonInContextMenu' Then

                      ctrl.Delete

                   End If

                Next ctrl

            End If

        End With

    Next

End Sub

可以在网上查找包含几乎每个上下文菜单中每个控件ID和控件图像ID的工作簿文件。

小结

在Excel 97至Excel 2003中，可以使用VBA代码将控件添加到每个上下文菜单中，但无法使用RibbonX更改上下文菜单。

在Excel 2007中，可以使用VBA代码将控件添加到几乎每个上下文菜单中。但是，无法使用VBA更改某些上下文菜单，例如形状和图片的上下文菜单。此外，无法使用RibbonX更改上下文菜单。

在Excel 2010及后续版本中，可以使用VBA代码将控件添加到几乎每个上下文菜单中。使用VBA更改某些上下文菜单的限制与Excel 2007中相同。此外，可以使用RibbonX向每个上下文菜单添加按钮和菜单。

注：本文学习整理自docs.microsoft.com，供有兴趣的朋友参考。