在Excel中自定义上下文菜单（下）
标签：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，供有兴趣的朋友参考。
腾讯云开发者
