Search code examples
vbaexcelexcel-2010submenu

Excel 2010 VBA Can't get Sub Menus to display


I have the following code that builds a custom menu in Excel. Works well. I'm trying to modify it to use sub menus. It will add the menu item for East Options and West Options. I'm trying to modify the East and West # 1 items so they appear as a sub menu. I've tried a number of different things but I haven't got the syntax right. Any help would be appreciated. Thanks.........

Dim cbWsMenuBar As CommandBar
Dim TrCustom As CommandBarControl
Dim iHelpIndex As Long
Dim vFoundMenu As Boolean
Set cbWsMenuBar = Application.CommandBars("Worksheet Menu Bar")

cbWsMenuBar.Visible = True

Dim CCnt As Long
For CCnt = 1 To cbWsMenuBar.Controls.Count
    If InStr(1, cbWsMenuBar.Controls(CCnt).Caption, "Translate") > 0 Then vFoundMenu = True
Next CCnt

If vFoundMenu = False Then

    Set TrCustom = cbWsMenuBar.Controls.Add(Type:=msoControlPopup) ', before:=iHelpIndex)
    With TrCustom

        .Caption = "Menu Items”

        With .Controls.Add(Type:=msoControlButton)
        .Caption = "Business Unit to Group"
        .OnAction = "ShowBU2GP"
        End With

        With .Controls.Add(Type:=msoControlButton)
        .Caption = "Group to Business Unit"
        .OnAction = "ShowGP2BU"
        End With

        With .Controls.Add(Type:=msoControlPopup)
        .Caption = "East Region Options"
        End With

‘       EAST # 1
'        With .Controls.Add(Type:=msoControlButton)
'        .Caption = "East Branch to  DeptID"
'        .OnAction = "ShowEastDeptID"
'        .BeginGroup = True
'        End With

         With .Controls.Add(Type:=msoControlPopup)
        .Caption = "West Options"
        End With

'       WEST # 1
'        With .Controls.Add(Type:=msoControlButton)
'        .Caption = "West Branch to DeptID"
'        .OnAction = "ShowWestDeptID"
'        .BeginGroup = True
'        End With

    End With

End If

Solution

  • I will show you a very simple example. Please amend it to suit your needs :)

    Private Sub Sample()
        Dim cb As CommandBar
        Dim cbc As CommandBarControl
        Dim newitem As CommandBarControl
        Dim newSubItem As CommandBarControl
    
        Set cb = Application.CommandBars(1)
    
        '~~> Delete Existing command bar control
        On Error Resume Next
        cb.Controls("Menu Items").Delete
        On Error GoTo 0
    
        '~~> Re Create the Command Bar Control
        Set cbc = cb.Controls.Add(Type:=msoControlPopup, temporary:=False)
    
        With cbc
            '~~> Main Heading
            .Caption = "Menu Items"
    
            '~~> First Sub Heading
            Set newitem = .Controls.Add(Type:=msoControlPopup)
            With newitem
                .BeginGroup = True
                .Caption = "East Region Options"
                Set newSubItem = .Controls.Add(Type:=msoControlButton)
                With newSubItem
                   .BeginGroup = True
                   '~~> Sub Item
                   .Caption = "Sub Item for East Region Options"
                   .Style = msoButtonCaption
                   .OnAction = "SomeMacro"
                End With
            End With
    
            '~~> Second Sub Heading
            Set newitem = .Controls.Add(Type:=msoControlPopup)
            With newitem
                .BeginGroup = True
                .Caption = "West Region Options"
                Set newSubItem = .Controls.Add(Type:=msoControlButton)
                With newSubItem
                   .BeginGroup = True
                   '~~> Sub Item
                   .Caption = "Sub Item for Est Region Options"
                   .Style = msoButtonCaption
                   .OnAction = "SomeMacro"
                End With
            End With
    
            '
            '~~> And So On
            '
        End With
    End Sub
    

    Screenshot

    enter image description here