Add Custom Options to Right Click Menu

Vishesh's picture

 

Often when using Excel, you want the ability to call a macro, but don't want to display a button. Adding Custom Options to Right Click Menu gives you this functionality. Create the data as in the first sheet of the attached xl file and copy the following code in Thisworkbook module. Right click to see that your menus appear in the right click menu list. There is also an option to specify whether to show 'Begin Group' separator line or not.

 

 

Option Explicit
 
Private Sub Workbook_Deactivate()
 
    Dim rngMenu         As Range
 
    Dim arrMenu()       As Variant
 
 
 
    Set rngMenu = shtMenu.Range("A1").CurrentRegion
 
    arrMenu() = rngMenu
 
    Call ResetCellRightClickMenu(arrMenu)
 
 
 
    Erase arrMenu
 
    Set rngMenu = Nothing
 
End Sub
 
 
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 
    Dim rngMenu         As Range
 
    Dim arrMenu()       As Variant
 
 
 
    Set rngMenu = shtMenu.Range("A1").CurrentRegion
 
    arrMenu() = rngMenu
 
    Call AddToCellRightClickMenu(arrMenu)
 
 
 
    Erase arrMenu
 
    Set rngMenu = Nothing
 
End Sub
 
 
 
Sub AddToCellRightClickMenu(arrMenu() As Variant)
 
    Dim lngMenuCount        As Long
 
    Dim cmdBarButton        As CommandBarButton
 
 
 
    For lngMenuCount = 2 To UBound(arrMenu(), 1)
 
        With Application
 
            On Error Resume Next
 
            .CommandBars("Cell").Controls(arrMenu(lngMenuCount, 1)).Delete
 
            On Error GoTo 0
 
            Set cmdBarButton = .CommandBars("Cell").Controls.Add(Temporary:=True)
 
        End With
 
 
 
        With cmdBarButton
 
            .Caption = arrMenu(lngMenuCount, 1)
 
            .Style = msoButtonCaption
 
            .OnAction = arrMenu(lngMenuCount, 2)
 
            On Error Resume Next
 
            .BeginGroup = arrMenu(lngMenuCount, 3)
 
            On Error GoTo 0
 
        End With
 
    Next lngMenuCount
 
 
 
    Set cmdBarButton = Nothing
 
End Sub
 
 
 
Sub ResetCellRightClickMenu(arrMenu() As Variant)
 
    Dim lngMenuCount        As Long
 
    For lngMenuCount = 2 To UBound(arrMenu(), 1)
 
        On Error Resume Next
 
        Application.CommandBars("Cell").Controls(arrMenu(lngMenuCount, 1)).Delete
 
        On Error GoTo 0
 
    Next lngMenuCount
 
 
 
End Sub 

Right Click Menu

AttachmentSize
RightClickMenus.xls35 KB