How Do I Add Add More Menus In A Pupup Menu?

Hi there,

See if the following code does what you need:

Option Explicit


'=========================================================================================
'=========================================================================================


Public Const msPOPUP_NAME As String = "MyPopUpMenu"


'=========================================================================================
'=========================================================================================


Sub DeletePopUpMenu()

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

End Sub


'=========================================================================================
'=========================================================================================


Sub CreateAndDisplayPopUpMenu()

'   Delete any existing popup menu.
    Call DeletePopUpMenu

'   Create the popup menu.
    Call CreatePopUpMenu

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

End Sub


'=========================================================================================
'=========================================================================================


Sub CreatePopUpMenu()

    Dim Menu_Special    As CommandBarPopup
    Dim Menu_Office     As CommandBarPopup
    Dim Menu_Google     As CommandBarPopup
    Dim Menu_IT         As CommandBarPopup

'   Add the popup menu.
    With Application.CommandBars.Add(Name:=msPOPUP_NAME, Position:=msoBarPopup, _
                                     MenuBar:=False, Temporary:=True)

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

        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Button 2"
            .FaceId = 72
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
        End With

'       Next, add a menu that contains the IT sub-menu.
        Set Menu_Special = .Controls.Add(Type:=msoControlPopup)
        With Menu_Special

            .Caption = "My Special Menu"

'           Add the IT sub-menu which will in turn contain two further sub-menus
            Set Menu_IT = .Controls.Add(Type:=msoControlPopup)
            With Menu_IT

                .Caption = "IT"

'               Add the Microsoft Office sub-menu which will contain two control buttons
                Set Menu_Office = .Controls.Add(Type:=msoControlPopup)

                With Menu_Office

                    .Caption = "Microsoft Office"

'                   Add the control buttons
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = "Office - Button 1"
                        .FaceId = 71
                        .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
                    End With

                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = "Office - Button 2"
                        .FaceId = 72
                        .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
                    End With

                End With

'               Add the Google Docs sub-menu which will contain two control buttons
                Set Menu_Google = .Controls.Add(Type:=msoControlPopup)

                With Menu_Google

                    .Caption = "Google Docs"

'                   Add the control buttons
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = "Google - Button 1"
                        .FaceId = 71
                        .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
                    End With

                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = "Google - Button 2"
                        .FaceId = 72
                        .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
                    End With

                End With

            End With

        End With

'       Finally, add a single button to the original (top-level) menu.
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Button 3"
            .FaceId = 73
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
        End With

    End With
End Sub


'=========================================================================================
'=========================================================================================


Sub TestMacro()
    MsgBox "Hi there!"
End Sub

Hope this helps - please let me know how you get on.

Regards,

Greg M