Adding sub-menu groups to contect menu

[jmpatrick]

I have code that I've used for yonks to create a custom right-click context menu. It's getting long and I'm wondering how to create sub menus to group related macros. Here's my code:

Private Sub Workbook_Open()

Dim contextMenu As CommandBar

Set contextMenu = Application.CommandBars("Cell")

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=30)
     .OnAction = "GeneralComment"
     .FaceId = 31
     .Caption = "Add Comment"
     .Tag = "My_Cell_Control_Tag"
End With

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=31)
     .OnAction = "DeleteGeneralComment"
     .FaceId = 31
     .Caption = "Delete Comment"
     .Tag = "My_Cell_Control_Tag"
End With

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=32)
     .OnAction = "OptionComment"
     .FaceId = 31
     .Caption = "Add Options Comment"
     .Tag = "My_Cell_Control_Tag"
End With

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=33)
     .OnAction = "DeleteOptionsComment"
     .FaceId = 31
     .Caption = "Delete Options Comment"
     .Tag = "My_Cell_Control_Tag"
End With

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=34)
     .OnAction = "AddComment"
     .FaceId = 31
     .Caption = "Sent to CC Comment"
     .Tag = "My_Cell_Control_Tag"
End With

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=35)
     .OnAction = "AddCommentReturn"
     .FaceId = 31
     .Caption = "Returned back from CC Comment"
     .Tag = "My_Cell_Control_Tag"
End With

With contextMenu.Controls.Add(Type:=msoControlButton, Before:=36)
     .OnAction = "DeleteComment"
     .FaceId = 31
     .Caption = "Delete Sent to CC Comment"
     .Tag = "My_Cell_Control_Tag"
End With

End Sub

 

[GWteB]

Perhaps something like this ...

Private Sub Workbook_Open()

    Dim contextMenu As CommandBar
    Dim myPopUp     As CommandBarPopup                      ' <<<<<<

    Set contextMenu = Application.CommandBars("Cell")

    With contextMenu.Controls
        With .Add(Type:=msoControlButton, Before:=30)
            .OnAction = "GeneralComment"
            .FaceId = 31
            .Caption = "Add Comment"
            .Tag = "My_Cell_Control_Tag"
        End With
    
        With .Add(Type:=msoControlButton, Before:=31)
            .OnAction = "DeleteGeneralComment"
            .FaceId = 31
            .Caption = "Delete Comment"
            .Tag = "My_Cell_Control_Tag"
        End With

        Set myPopUp = .Add(Type:=msoControlPopup)           ' <<<<<<

    End With


    With myPopUp.Controls                                   ' <<<<<<
        With .Add(Type:=msoControlButton)
            .OnAction = "OptionComment"
            .FaceId = 31
            .Caption = "Add Options Comment"
            .Tag = "My_Cell_Control_Tag"
        End With

        With .Add(Type:=msoControlButton)
            .OnAction = "DeleteOptionsComment"
            .FaceId = 31
            .Caption = "Delete Options Comment"
            .Tag = "My_Cell_Control_Tag"
        End With
    End With

End Sub

 

[jmpatrick]

Perhaps something like this ...

Private Sub Workbook_Open()

    Dim contextMenu As CommandBar
    Dim myPopUp     As CommandBarPopup                      ' <<<<<<

    Set contextMenu = Application.CommandBars("Cell")

    With contextMenu.Controls
        With .Add(Type:=msoControlButton, Before:=30)
            .OnAction = "GeneralComment"
            .FaceId = 31
            .Caption = "Add Comment"
            .Tag = "My_Cell_Control_Tag"
        End With
   
        With .Add(Type:=msoControlButton, Before:=31)
            .OnAction = "DeleteGeneralComment"
            .FaceId = 31
            .Caption = "Delete Comment"
            .Tag = "My_Cell_Control_Tag"
        End With

        Set myPopUp = .Add(Type:=msoControlPopup)           ' <<<<<<

    End With


    With myPopUp.Controls                                   ' <<<<<<
        With .Add(Type:=msoControlButton)
            .OnAction = "OptionComment"
            .FaceId = 31
            .Caption = "Add Options Comment"
            .Tag = "My_Cell_Control_Tag"
        End With

        With .Add(Type:=msoControlButton)
            .OnAction = "DeleteOptionsComment"
            .FaceId = 31
            .Caption = "Delete Options Comment"
            .Tag = "My_Cell_Control_Tag"
        End With
    End With

End Sub

This works nicely. Is it possible to have a caption for the sub menu? With your code it's just blank with an arrow.

 

[GWteB]

I could have been a little more elaborate. So try ...

    Dim contextMenu As CommandBar
    Dim myPopUp     As CommandBarPopup                      ' <<<<<<

    Set contextMenu = Application.CommandBars("Cell")

    With contextMenu.Controls
        Set myPopUp = .Add(Type:=msoControlPopup)           ' <<<<<<
        With myPopUp
            .Caption "All About Comments"
            .Tag = "My_Cell_Control_Tag"
        End With
    End With

 

[jmpatrick]

I could have been a little more elaborate. So try ...

    Dim contextMenu As CommandBar
    Dim myPopUp     As CommandBarPopup                      ' <<<<<<

    Set contextMenu = Application.CommandBars("Cell")

    With contextMenu.Controls
        Set myPopUp = .Add(Type:=msoControlPopup)           ' <<<<<<
        With myPopUp
            .Caption "All About Comments"
            .Tag = "My_Cell_Control_Tag"
        End With
    End With

Perfect. Thanks.