ExcelBanter - Creating a SubMenu

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Creating a SubMenu (https://www.excelbanter.com/excel-programming/291405-creating-submenu.html)

Creating a SubMenu

Hi Ya'll

I have created a custom menu and I am having trouble creating a submen
for one of the menu items... I have spent some time searching o
google, I am getting close just not close enough.
I get a run-time error '438' in the submenu part of the code.

Thanks for any help

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, befo=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:=msoControlButton)
With MenuItem
.Caption = "&View Summary..."
.FaceId = 592
.OnAction = "Summary"
End With

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

Rockee
Excel 200

--
Message posted from http://www.ExcelForum.com

Creating a SubMenu

Rockee,

When creating a sub-menu, you first have to create a control of type
msoControlPopup. Here is some amended code to show you how

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, befo=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

--

HTH

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

"Rockee052 " wrote in message
...
Hi Ya'll

I have created a custom menu and I am having trouble creating a submenu
for one of the menu items... I have spent some time searching on
google, I am getting close just not close enough.
I get a run-time error '438' in the submenu part of the code.

Thanks for any help

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, befo=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:=msoControlButton)
With MenuItem
Caption = "&View Summary..."
FaceId = 592
OnAction = "Summary"
End With

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

Rockee
Excel 2003

---
Message posted from http://www.ExcelForum.com/

Creating a SubMenu

Bob,

Thanks for your help

Rocke

--
Message posted from http://www.ExcelForum.com

Creating a SubMenu

Check my website for an example of CommandBars

--
Rob van Gelder - http://www.vangelder.co.nz/excel

"Rockee052 " wrote in message
...
Hi Ya'll

I have created a custom menu and I am having trouble creating a submenu
for one of the menu items... I have spent some time searching on
google, I am getting close just not close enough.
I get a run-time error '438' in the submenu part of the code.

Thanks for any help

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, befo=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:=msoControlButton)
With MenuItem
Caption = "&View Summary..."
FaceId = 592
OnAction = "Summary"
End With

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

Rockee
Excel 2003

---
Message posted from http://www.ExcelForum.com/