submenu help (how to create arrow for expanding menu)

[Guest]

How is a menu created from an item in a menu? For example, in Excel the
"Data" "Filter" menu expands to auto filter etc. How can I create this in a
custom menu. The menu displays a small arrow on the right that then expands
to another menu.

Thanks!
Dave

 

[Bob Phillips]

Dave,

When creating the menu item, you define it as type msoControlPopup, not
msoControlButton. You then have to create controls within that control to
have the next level, something like

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()
On Error Resume Next

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


End Sub



--

HTH

RP
(remove nothere from the email address if mailing direct)