popup menu

[Chewyhairball]

Hi Folks,

I have a code that gives me a nice popup menu( in my example there are 3 options to choose from).
It works really well but i was wondering if a sub menu was possible. Like selecting the first item from the menu which would then open up with further options to choose from.
thanks for any help with this.

Option Explicit
Public Const Mname As String = "MyPopUpMenu"



Sub CreatePopUpMenu()
    ' Delete any existing popup menu.
    Call DeletePopUpMenu

    ' Create the popup menu.
    Call Custom_PopUpMenu_Actions

    ' Display the popup menu.
    On Error Resume Next
    Application.CommandBars(Mname).ShowPopup
    On Error GoTo 0
End Sub




Sub DeletePopUpMenu()
    ' Delete the popup menu if it already exists.
    On Error Resume Next
    Application.CommandBars(Mname).Delete
    On Error GoTo 0
End Sub


Sub Custom_PopUpMenu_Actions()
    Dim MenuItem As CommandBarPopup
    ' Add the popup menu.
    With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _
         MenuBar:=False, Temporary:=True)

        ' First, add two buttons to the menu.
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Add Comments"
            .FaceId = 67
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro1"
        End With



        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Add Comments"
            .FaceId = 329
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro2"
        End With

        
        
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Add Comments"
            .FaceId = 225
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro3"
        End With

                
                
                
        
        End With
    
End Sub

 

[KOKOSEK]

Try like this:

Sub Custom_PopUpMenu_Actions()
Dim MenuItem As CommandBarPopup

Set MyPopMenu = Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, MenuBar:=False, Temporary:=True)
With MyPopMenu
    ' 1st submenu
    Set SubMenu1 = .Controls.Add(msoControlPopup)
    With SubMenu1
        .Caption = "Goto submenu 1"
        .Enabled = True
    End With
    
    'option button 1
    Set option2 = .Controls.Add(Type:=msoControlButton)
    With option2
        .Caption = "Option 1"
        .FaceId = 329
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro2"
    End With
    
    ' 2st submenu
    Set SubMenu2 = .Controls.Add(msoControlPopup)
    With SubMenu2
        .Caption = "Goto submenu 1"
        .Enabled = True
    End With

    'option button 2
    Set option2 = .Controls.Add(Type:=msoControlButton)
    With option2
        .Caption = "Option 2"
        .FaceId = 225
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro3"
    End With
End With
        
With SubMenu1
    ' add 1st button to 1st submenu
    Set SubOption1 = .Controls.Add(Type:=msoControlButton)
    With SubOption1
        .Caption = "My macro number 1"
        .FaceId = 67
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro1"
    End With
    ' add 2st button to 1st submenu
    Set SubOption2 = .Controls.Add(Type:=msoControlButton)
    With SubOption2
        .Caption = "My macro number 3"
        .FaceId = 67
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro1"
    End With
End With

With SubMenu2
    ' add 1st button to 2st submenu
    Set SubOption3 = .Controls.Add(Type:=msoControlButton)
    With SubOption3
        .Caption = "My macro number 3"
        .FaceId = 67
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro1"
    End With
    ' add 2st button to 2st submenu
    Set SubOption4 = .Controls.Add(Type:=msoControlButton)
    With SubOption4
        .Caption = "My macro number 4"
        .FaceId = 67
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "macro1"
    End With
End With

End Sub

 

[Chewyhairball]

Thank very much. It doesnt seem to work for me. It keeps giving me an error with 'Mname.

I decided on a different route so its not urgent I get this. Might be useful to play about with on other projects though.

 

[KOKOSEK]

Probably you replace whole code while I've put only new

sub Custom_PopUpMenu_Actions()

everything from your original code which was above that HAVE TO STATY AS IT WAS.
Especially:

Public Const Mname As String = "MyPopUpMenu"