Excel 2010 VBA Can't get Sub Menus to display

1.1k views Asked by At

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
1

There are 1 answers

1
Siddharth Rout On BEST ANSWER

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