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