根据单元格内容创建自定义弹出菜单

下面介绍如何在Excel中创建自定义弹出菜单。
Excel有许多可用的右键弹出菜单，其内容取决正在做什么，术语称为上下文菜单。例如，在单元格中单击右键，将出现“单元格”弹出菜单及其可用的选择。这个菜单可以定制，即允许在其中添加项目或者禁用项目。
取决于需要，下拉菜单可能会变得非常巨大。进一步说，如果取决于单元格内容而为每个单元格获得相同的菜单，可能会有太多的选择。一个完整的基于单元格内容或区域的自定义菜单，将会更好地满足特定的需要。
下面的代码使得您在当前工作簿的任何工作表中，右键单击分别填充有红色、黄色和绿色阴影的单元格时，创建并弹出三个自定义菜单（红色、黄色和绿色）。
本示例需要在Workbook.Open事件中编写代码，同时需要一个代码模块和一个类模块。
关键是类模块。类模块包含工作表事件的处理，无论何时在工作簿的任何工作表中发生操作时触发该事件。特别需要说明的是Worksheet.BeforeRightClick事件，正如其名字所表示的意思，即当用户右击工作表时发生默认的操作之前希望做的事情。
本例中，Range.Interior属性用于访问单元格的Interior.ColorIndex属性。取决于颜色返回的值，取消了默认的弹出菜单，并且根据返回的属性值显示相应的弹出菜单。

这项技术可用于自定义Excel解决方案，限制最终用户只做特定的任务。
Workbook_Open
Workbook_Open事件处理建立三个弹出菜单，并在类中创建工作表对象。打开VBE，将下面的代码粘贴到ThisWorkbook模块中：

Private Sub Workbook_Open()Set cb_Red = CreateSubMenu("红色")Set cb_Yellow = CreateSubMenu("黄色")Set cb_Green = CreateSubMenu("绿色")Call SetupAllWSEventsEnd Sub

代码模块
代码模块包含类设置和实际的菜单创建过程。在VBE中，插入一个标准模块，将下面的代码粘贴到该模块中：

Global cb_Red As CommandBarGlobal cb_Yellow As CommandBarGlobal cb_Green As CommandBarGlobal WSObj As CollectionGlobal ws As Worksheet Sub SetupAllWSEvents() Dim WSo As clsWsSet WSObj = NothingSet WSObj = New CollectionFor Each ws In ActiveWorkbook.WorksheetsSet WSo = New clsWsSet WSo.WSToMonitor = wsWSObj.Add WSo, ws.NameNext ws End Sub Function CreateSubMenu(strCB) As CommandBar Const CBPREFIX = "CustomPopUp"Dim cb As CommandBarDim cbc As CommandBarControlDim strCBName As String'自定义菜单名称    strCBName = CBPREFIX & strCB'移除以前的实例    Call DeleteCommandBar(strCBName)'添加弹出菜单到CommandBars集合    Set cb = CommandBars.Add(Name:=strCBName, _Position:=msoBarPopup, _MenuBar:=False, _Temporary:=False)'添加控件    Set cbc = cb.Controls.AddWith cbc.Caption = strCB & " 控件 1".OnAction = "DummyMessage"End With Set cbc = cb.Controls.AddWith cbc.Caption = strCB & " 控件 2".OnAction = "DummyMessage"End With Set CreateSubMenu = cbSet cbc = NothingSet cb = Nothing End FunctionSub DeleteCommandBar(cbName) On Error Resume NextCommandBars(cbName).Delete End SubSub DummyMessage()MsgBox CommandBars.ActionControl.Caption, vbInformation + vbOKOnly, "Dummy Message"End Sub

类模块
类模块根据目标单元格的特征决定弹出哪个菜单。在VBE中，插入类模块，将其名字改为clsWS，并在其中粘贴下列代码：

Dim WithEvents aWS As Worksheet Property Set WSToMonitor(uWS As Worksheet)Set aWS = uWSEnd Property Private Sub aWS_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)Select Case Target.Interior.ColorIndexCase 3, 9cb_Red.ShowPopupCancel = True '使标准的单元格弹出菜单失效    Case 4, 10, 14, 35, 43, 50, 51, 52cb_Green.ShowPopupCancel = TrueCase 6, 12, 36, 44cb_Yellow.ShowPopupCancel = TrueCase ElseCancel = FalseEnd SelectEnd Sub

代码测试
如上图所示，在某工作表中分别使用红色、黄色、绿色填充单元格，保存并关闭工作簿。然后重新打开该工作簿，此时在有颜色的单元格中单击右键，会出现不同的自定义弹出菜单。