Create Submenus : Menu « Application « VBA / Excel / Access / Word

1. VBA / Excel / Access / Word
2. Application
3. Menu

Create Submenus

 
Public Sub newSubMenu()
   Dim menuBar As CommandBar
   Dim newMenu As CommandBarControl
   Dim menuItem As CommandBarControl
   Dim subMenuItem As CommandBarControl
   
   Set menuBar = CommandBars.Add(menuBar:=True, Position:=msoBarTop, Name:="Sub Menu Bar", Temporary:=True)
   menuBar.Visible = True
   
   Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
   newMenu.Caption = "&First Menu"
   
   Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
   newMenu.Caption = "&Second Menu"
   
   Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
   newMenu.Caption = "&Third Menu"
   
   Set menuItem = newMenu.Controls.Add(Type:=msoControlButton)
   
   With menuItem
      .Caption = "F&irst Sub"
      .FaceId = "356"
      .OnAction = "myTest"
   End With
   
   Set menuItem = newMenu.Controls.Add(Type:=msoControlButton)
   
   With menuItem
      .Caption = "S&econd Sub"
      .FaceId = "333"
      .OnAction = "otherTest"
   End With
   
   Set menuItem = newMenu.Controls.Add(Type:=msoControlPopup)
   menuItem.Caption = "Sub Menus"
   
   Set subMenuItem = menuItem.Controls.Add(Type:=msoControlButton)
   
   With subMenuItem
      .Caption = "Item 1"
      .FaceId = 321
      .OnAction = "firstMacro"
   End With
   
   Set subMenuItem = menuItem.Controls.Add(Type:=msoControlButton)
   
   With subMenuItem
      .Caption = "Item 2"
      .FaceId = 432
      .OnAction = "secondMacro"
   End With
   
End Sub

 

Related examples in the same category