Excel Menus that fold out

[GJones]

Could you give me a snippet that does a dynamic menu with
a sub menu in it similar to the standard on when you go to
File / Print Setup

Thanks

Greg

 

[Bob Phillips]

Hi Greg,

here is an example

Sub PartsMenu()
Dim HelpMenu As CommandBarControl
Dim MainMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
Dim Submenuitem As CommandBarButton

' Deletes menu if it exits
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 MainMenu = CommandBars(1).Controls. _
Add(Type:=msoControlPopup, temporary:=True)
Else
' Add menu before help
Set MainMenu = CommandBars(1).Controls. _
Add(Type:=msoControlPopup, before:=HelpMenu.Index, _
temporary:=True)
End If

' Add caption
MainMenu.Caption = "&Parts Utility"

' Searching for parts
Set MenuItem = MainMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Search Parts..."
.FaceId = 48
.ShortcutText = "Ctrl+Shift+S"
.OnAction = "SetupSearch"
End With

' LO / Remaining printout
Set MenuItem = MainMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Generate Parts Review..."
.FaceId = 285
.ShortcutText = "Ctrl+Shift+D"
.OnAction = "LORemaining"
End With

' View summary sheet
Set MenuItem = MainMenu.Controls.Add _
(Type:=msoControlPopup)
With MenuItem
.Caption = "Sub menu"
End With

Set Submenuitem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With Submenuitem
.Caption = "&View Summary..."
.FaceId = 592
.OnAction = "Summary"
End With

' Error is here
' Print summary sheet
Set Submenuitem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With Submenuitem
.Caption = "Print Summary"
' .Application = 364
.OnAction = "PrintSummary"
End With
End Sub

Sub DeleteMenu()
Application.CommandBars("Worksheet Menu Bar").Controls("Parts
Utility").Delete

End Sub



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[David]

Bob Phillips wrote

Sub DeleteMenu()
Application.CommandBars("Worksheet Menu Bar").Controls("Parts
Utility").Delete

To avoid error when first run:

Sub DeleteMenu()
On Error Resume Next 'This will bypass deletion if menu doesn't exist
Application.CommandBars("Worksheet Menu Bar").Controls("Parts
Utility").Delete
End Sub