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

yuxinrong 2009-10-29

展开全文

下面介绍如何在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 SetupAllWSEvents
End Sub

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

Global cb_Red As CommandBar
Global cb_Yellow As CommandBar
Global cb_Green As CommandBar
Global WSObj As Collection
Global ws As Worksheet
 
Sub SetupAllWSEvents()
 
Dim WSo As clsWs
Set WSObj = Nothing
Set WSObj = New Collection
For Each ws In ActiveWorkbook.Worksheets
Set WSo = New clsWs
Set WSo.WSToMonitor = ws
WSObj.Add WSo, ws.Name
Next ws
 
End Sub
 
Function CreateSubMenu(strCB) As CommandBar
 
Const CBPREFIX = "CustomPopUp"
Dim cb As CommandBar
Dim cbc As CommandBarControl
Dim 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.Add
With cbc
.Caption = strCB & " 控件 1"
.OnAction = "DummyMessage"
End With
 
Set cbc = cb.Controls.Add
With cbc
.Caption = strCB & " 控件 2"
.OnAction = "DummyMessage"
End With
 
Set CreateSubMenu = cb
Set cbc = Nothing
Set cb = Nothing
 
End Function
Sub DeleteCommandBar(cbName)
 
On Error Resume Next
CommandBars(cbName).Delete
 
End Sub
Sub 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 = uWS
End Property
 
Private Sub aWS_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Interior.ColorIndex
Case 3, 9
cb_Red.ShowPopup
Cancel = True '使标准的单元格弹出菜单失效
    Case 4, 10, 14, 35, 43, 50, 51, 52
cb_Green.ShowPopup
Cancel = True
Case 6, 12, 36, 44
cb_Yellow.ShowPopup
Cancel = True
Case Else
Cancel = False
End Select
End Sub