J
John Petty
I have written some code that generates a menu on the
MenuBar. Within this menu, I have a few items and one of
those items generates a popup (i.e. group = True). My
problem is that I want to embed another level into one or
more of the popup menus, and I can't seem to do it.
See below for the code.
Dim HelpMenu As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
Dim SubMenuItem As CommandBarButton
' Delete the Menu if existing
Call DeleteMenu
' Find the Help Menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then
' Add the Menu to the End
Set NewMenu = CommandBars(1).Controls _
.Add(Type:=msoControlPopup, Temporary:=True)
Else
' Add the menu before help
Set NewMenu = CommandBars(1).Controls _
.Add(Type:=msoControlPopup, Before:=HelpMenu.Index, _
Temporary:=True)
End If
' Add A Caption
NewMenu.Caption = "&Name"
' First Menu Item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlPopup, Temporary:=True)
With MenuItem
.Caption = "Engineering Forms"
.BeginGroup = True
End With
' First SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Release"
.OnAction = "EOR"
End With
' Second SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Change"
.OnAction = "EOC"
End With
' Third SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "StockDisposition"
.OnAction = "EOS"
End With
' Fourth SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Bill Of Materials"
.OnAction = "EOB"
End With
' Second Menu Item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Signatures"
.BeginGroup = False
.OnAction = "Sig"
End With
' First Hyperlink Menu Item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Drawing Database"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.TooltipText = "Hyperlink Location"
End With
End Sub
MenuBar. Within this menu, I have a few items and one of
those items generates a popup (i.e. group = True). My
problem is that I want to embed another level into one or
more of the popup menus, and I can't seem to do it.
See below for the code.
Dim HelpMenu As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
Dim SubMenuItem As CommandBarButton
' Delete the Menu if existing
Call DeleteMenu
' Find the Help Menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then
' Add the Menu to the End
Set NewMenu = CommandBars(1).Controls _
.Add(Type:=msoControlPopup, Temporary:=True)
Else
' Add the menu before help
Set NewMenu = CommandBars(1).Controls _
.Add(Type:=msoControlPopup, Before:=HelpMenu.Index, _
Temporary:=True)
End If
' Add A Caption
NewMenu.Caption = "&Name"
' First Menu Item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlPopup, Temporary:=True)
With MenuItem
.Caption = "Engineering Forms"
.BeginGroup = True
End With
' First SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Release"
.OnAction = "EOR"
End With
' Second SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Change"
.OnAction = "EOC"
End With
' Third SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "StockDisposition"
.OnAction = "EOS"
End With
' Fourth SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Bill Of Materials"
.OnAction = "EOB"
End With
' Second Menu Item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Signatures"
.BeginGroup = False
.OnAction = "Sig"
End With
' First Hyperlink Menu Item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Drawing Database"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.TooltipText = "Hyperlink Location"
End With
End Sub