Custom Right-Click Menu & Submenu

[efernandes67]

Hi,

I want to create a right click custom menu so that it only shows the my options. By this I mean that I want to hide or disable the default options.

I know I can disable options this way:

        With Application
            .CommandBars("Cell").Controls("Cut").Visible = False
            .CommandBars("Cell").Controls("Filter").Visible = False
            .CommandBars("Cell").Controls("Sort").Visible = False
        End With

It's possible to disable all the default options? How can I get the list of all CommandBars("Cell")?

Regards,
Elio Fernandes

[romperstomper]

Is this for a specific sheet, or for all workbooks? If it's for a specific sheet, then I would create your own commandbar and show that instead of the default one rather than altering the Cell menus (note: there are two of them).

[efernandes67]

Hi,

It's for a specifc sheet. How I show my commandbar instead of the default?

Regards,
Elio Fernandes

Is this for a specific sheet, or for all workbooks? If it's for a specific sheet, then I would create your own commandbar and show that instead of the default one rather than altering the Cell menus (note: there are two of them).

[romperstomper]

In the worksheet's code module (right-click the sheet tab, and choose View Code):

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    ' cancel default shortcut menu
    Cancel = True
    ShowPopupMenu
End Sub

then in a normal module:

Sub ShowPopupMenu()
    Const cstrBarName As String = "MyCellPopup"
    Dim cbr As CommandBar, ctl As CommandBarControl
    On Error Resume Next
    Application.CommandBars(cstrBarName).Delete
    On Error GoTo err_handler
    ' add new popup menu
    Set cbr = Application.CommandBars.Add(cstrBarName, msoBarPopup, , True)
    ' add a couple of buttons
    Set ctl = cbr.Controls.Add
    With ctl
        .Caption = "Macro1"
        .OnAction = "'" & ThisWorkbook.Name & "'!macro1"
        .Style = msoButtonCaption
    End With
    Set ctl = cbr.Controls.Add
    With ctl
        .Caption = "Macro2"
        .OnAction = "'" & ThisWorkbook.Name & "'!macro2"
        .Style = msoButtonCaption
    End With
    cbr.ShowPopup
    cbr.Delete
    Exit Sub
    
err_handler:
    MsgBox Err.Description
End Sub

adjust the number of controls and macro names as required.

[efernandes67]

Thanks, it's just what I need.

Regards,
Elio Fernandes

[efernandes67]

Hi,

You helped me in my post "Custom Right-Click Menu".
Can you tell me how to create a submenu similar to this:

item1
--------
item2 - subitem1
- subitem2
--------
item3


Regards,
Elio Fernande

[romperstomper]

Here's a revised version of the original code - it adds two buttons, then a submenu with another two buttons:

Sub ShowPopupMenu()
    Const cstrBarName As String = "MyCellPopup"
    Dim cbr As CommandBar, ctl As CommandBarControl, ctlSub As CommandBarControl
    On Error Resume Next
    Application.CommandBars(cstrBarName).Delete
    On Error GoTo err_handler
    ' add new popup menu
    Set cbr = Application.CommandBars.Add(cstrBarName, msoBarPopup, , True)
    ' add a couple of buttons
    Set ctl = cbr.Controls.Add
    With ctl
        .Caption = "Macro1"
        .OnAction = "'" & ThisWorkbook.Name & "'!macro1"
        .Style = msoButtonCaption
    End With
    Set ctl = cbr.Controls.Add
    With ctl
        .Caption = "Macro2"
        .OnAction = "'" & ThisWorkbook.Name & "'!macro2"
        .Style = msoButtonCaption
    End With
    ' add a sub menu
    Set ctlSub = cbr.Controls.Add(msoControlPopup)
    ctlSub.Caption = "Popup menu"
    ' now add a couple of buttons to it
    Set ctl = ctlSub.Controls.Add
    With ctl
        .Caption = "Macro3"
        .OnAction = "'" & ThisWorkbook.Name & "'!macro3"
        .Style = msoButtonCaption
    End With
    Set ctl = ctlSub.Controls.Add
    With ctl
        .Caption = "Macro4"
        .OnAction = "'" & ThisWorkbook.Name & "'!macro4"
        .Style = msoButtonCaption
    End With
    cbr.ShowPopup
    cbr.Delete
    Exit Sub
    
err_handler:
    MsgBox Err.Description
End Sub

[efernandes67]

Thanks agian.

Regards,
Elio Fernandes