Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Excel VBA - Add submenu to custom right-click menu

Tags:

excel

vba

Long time viewer, first time poster. I have a form with Right-Click functions that work fine. I'm trying to add a sub menu to the main right-click menu to separate some functions/command. I need/want to insert the section where the 'Select Case' is, however, its only showing the top menu. Not sure where to go from here. Any help would be awesome

Thanks :)

P.S. I would be happy to explain further if needed.

Sub fzCopyPaste(iItems As Integer)
On Error Resume Next
CommandBars("Custom").Delete
Set PopBar = CommandBars.Add(Name:="Custom", Position:=msoBarPopup, MenuBar:=False, Temporary:=True)

'Add top_menu on Main Popbar : This work fine

Set top_menu = PopBar.Controls.Add(Type:=msoControlButton)
With top_menu
    '.FaceId =
    .Caption = "&Some Commands"
End With

Need to Insert the below sub menu(s) into the top menu But nothing shows up : Does not work

Select Case iItems
Case 1  ' Copy and Paste
    Set copy_button = top_menu.Controls.Add(Type:=msoControlButton)
    With copy_button
        .FaceId = 19
        .Caption = "&Copy"
        .Tag = "tCopy"
        .OnAction = "fzCopyOne(true)"
    End With

    Set paste_button = top_menu.Controls.Add(Type:=msoControlButton)
    With paste_button
        .FaceId = 22
        .Tag = "tPaste"
        .Caption = "&Paste"
        .OnAction = "fzCopyOne(true)"
    End With
Case 2 '  Paste Only
    Set paste_button = top_menu.Controls.Add(Type:=msoControlButton)
    With paste_button
        .FaceId = 22
        .Tag = "tPaste"
        .Caption = "&Paste"
        .OnAction = "fzCopyOne(true)"
    End With
End Select

'Extra top menue(s) below here : This work fine

    Set paste_button = PopBar.Controls.Add(Type:=msoControlButton)
    With paste_button
        .FaceId = 22
        .Tag = "tPaste"
        .Caption = "Main POP BAR 2"
        .OnAction = "fzCopyOne(true)"
    End With


PopBar.ShowPopup

CommandBars("Custom").Delete
End Sub
like image 948
DayLove.01 Avatar asked Jul 14 '16 14:07

DayLove.01


People also ask

How do I add options to the right click menu in Excel?

First, open the workbook in which you want to add the context menu item. Next, select the cell or range of cells to which you want to add the context menu item. Finally, right-click on the selected cell or range of cells and select "Add to Context Menu" from the drop-down menu that appears.

Where is context menu in Excel?

The most well know context menu is the cells menu. When you right click on a worksheet cell or selection you're presented with a menu with a range of options for copy and pasting, cell formatting and other functions.


1 Answers

You set Copy_Button equal to an msoControlButton. If you want a button, this is correct. You want a menu though, so you should set it to an msoControlPopup. Try something like this:

Set Top_Menu = PopBar.Controls.Add(Type:=msoControlPopup)
With Top_Menu 
    .Caption = "&Some Commands"
    Set MySubMenu = .Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True)
    Select Case iItems
        Case 1
            With MySubMenu
                .Caption = "Submenu Commands"
                With .Controls.Add(Type:=msoControlButton, before:=1, temporary:=True)
                    .FaceId = 19
                    .Caption = "&Copy"
                    .Tag = "tCopy"
                    .OnAction = "fzCopyOne(true)"
                End With

                With .Controls.Add(Type:=msoControlButton, before:=2, temporary:=True)
                    .FaceId = 22
                    .Tag = "tPaste"
                    .Caption = "&Paste"
                    .OnAction = "fzCopyOne(true)"
                End With
            End With
        Case 2
            'etc
    End Select
End With

I removed the “Top_Menu” section (first 3 lines) with the below; it was adding an extra button and then the desired menu.

Set MySubMenu = PopBar.Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True)
With MySubMenu
    .Caption = "&Some Commands"
like image 143
Tim Avatar answered Nov 15 '22 07:11

Tim