Custom Popup Worksheet Menus
Posted by Derek Mang on May 16th, 2007
Microsoft Excel has lots of popup (or dropdown) menus (or commandbars) that are made available to the user with a right-click depending on what your doing - hence the term context menu.
Right-click on a cell and you get the "cell" menu. This is subject to customization, allowing you to add items to the menu or disable menu items if desired.
Depending on your needs, the dropdown menu could get to be awkwardly large. Furthermore, you get the same menu for each cell, and if there are dependencies on cell content you may wind up with too many choices.
This example provides a neat little solution to this problem. I found the inspiration on the net authored by Andy Wiggins (Byg Software). Andy's code was focused on one worksheet only, with one menu for all cells.
I have shamelessly taken said code (with full kudos here for Andy), and added a few things to create a workbook with three custom menues (Red, Yellow and Green) that will popup on any worksheet in the current workbook where the right-clicked cell is a shade of red, yellow or green respectively.
The workbook requires one code module, and one class module (clsWS).
So here goes:
Code for the workbook_open event establishes the three popup menus, and sets up the worksheet objects in the class.
Set gcBar_Red = CreateSubMenu("Red")
Set gcBar_Yellow = CreateSubMenu("Yellow")
Set gcBar_Green = CreateSubMenu("Green")
Call SetupAllWSEvents
End Sub
The code module contains the class set up and the actual menu creation routines.
Module code:
Global gcBar_Red As CommandBar
Global gcBar_Yellow As CommandBar
Global gcBar_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
'' ***************************************************************************
'' Purpose : Demo
'' Written : 18-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Function CreateSubMenu(strCB) As CommandBar
''Name for popup menu
Const lcon_PuName = "PopUp"
''Create some objects
Dim cb As CommandBar
Dim cbc As CommandBarControl
Dim strCBName As String
strCBName = lcon_PuName & strCB
''Ensure our popup menu does not exist
DeleteCommandBar strCBName
''Add our popup menu to the CommandBars collection
Set cb = CommandBars.Add(Name:=strCBName, Position:=msoBarPopup, MenuBar:=False, Temporary:=False)
'' Add some demo controls
Set cbc = cb.Controls.Add
With cbc
.Caption = strCB & " &Control 1"
.OnAction = "DummyMessage"
End With
Set cbc = cb.Controls.Add
With cbc
.Caption = strCB & " Control &2"
.OnAction = "DummyMessage"
End With
Set CreateSubMenu = cb
End Function
Sub DeleteCommandBar(menuName)
Dim mb As Object
For Each mb In CommandBars
If mb.Name = menuName Then
CommandBars(menuName).Delete
End If
Next
End Sub
Sub DummyMessage()
MsgBox "Hello", vbInformation + vbOKOnly, "Dummy Message"
End Sub
The class module determines which menu to "popup" depending on characteristics of the target cell.
Class Module code:
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
gcBar_Red.ShowPopup
Cancel = True 'defeat the standard cell popup menu
Case 4, 10, 35, 43, 50, 51, 52
gcBar_Green.ShowPopup
Cancel = True
Case 6, 12, 36, 44
gcBar_Yellow.ShowPopup
Cancel = True
Case Else
Cancel = False
End Select
End Sub
Other conditions would be added to the _BeforeRightClick event as needed.
