Adding Sub Menu Item to Current Custom Menu

I currently running the following code to create a Custom Menu:

Sub AddNewMenu()
Dim HelpIndex As Integer
Dim NewMenu As CommandBarPopup

' Get Index of Help menu
HelpIndex = CommandBars(1).Controls("Help").Index

' Create the control
Set NewMenu = CommandBars(1) _
.Controls.Add(Type:=msoControlPopup, _
Before:=HelpIndex, Temporary:=True)
' Add a caption
NewMenu.Caption = "&Michigan154"
End Sub

Sub Allen()
Dim Item As CommandBarControl
Set Item = CommandBars(1).Controls("Michigan154") _
.Controls.Add
Item.Caption = "&Allen Park"
Item.OnAction = "AllenPark_154"
End Sub

How can I add some submenus to this?
Thanks

Something like this

Sub Allen()
Dim Item As CommandBarControl
Set Item = CommandBars(1).Controls("Michigan154") _
.Controls.Add
With Item
.Caption = "&Allen Park"
.OnAction = "AllenPark_154"
With .Controls.Add(Type:=msoControlPopup)
.Caption = "SubMenu"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Sub Item 1"
.OnAction = "myMacro1"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Sub Item 2"
.OnAction = "myMacro2"
End With
End With
End With
End Sub



--

HTH

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


"Renato" <[email protected]> wrote in message
news:[email protected]...
> I currently running the following code to create a Custom Menu:
>
> Sub AddNewMenu()
> Dim HelpIndex As Integer
> Dim NewMenu As CommandBarPopup
>
> ' Get Index of Help menu
> HelpIndex = CommandBars(1).Controls("Help").Index
>
> ' Create the control
> Set NewMenu = CommandBars(1) _
> .Controls.Add(Type:=msoControlPopup, _
> Before:=HelpIndex, Temporary:=True)
> ' Add a caption
> NewMenu.Caption = "&Michigan154"
> End Sub
>
> Sub Allen()
> Dim Item As CommandBarControl
> Set Item = CommandBars(1).Controls("Michigan154") _
> .Controls.Add
> Item.Caption = "&Allen Park"
> Item.OnAction = "AllenPark_154"
> End Sub
>
> How can I add some submenus to this?
> Thanks
>
>
>
>

Something like:

Option Explicit
Sub AddNewMenu()

Dim HelpIndex As Integer
Dim NewMenu As CommandBarPopup

On Error Resume Next
Application.CommandBars(1).Controls("&Michigan154").Delete
On Error GoTo 0

' Get Index of Help menu
HelpIndex = CommandBars(1).Controls("Help").Index

' Create the control
Set NewMenu = CommandBars(1) _
.Controls.Add(Type:=msoControlPopup, _
Before:=HelpIndex, temporary:=True)
' Add a caption
NewMenu.Caption = "&Michigan154"
End Sub

Sub Allen()
Dim Item As CommandBarControl
Dim SubItem As CommandBarControl
Set Item = CommandBars(1).Controls("Michigan154") _
.Controls.Add(Type:=msoControlPopup)

With Item
.Caption = "&Allen Park"
Set SubItem = .Controls.Add(Type:=msoControlButton, temporary:=True)
With SubItem
.Caption = "next level"
.OnAction = "AllenPark_154"
End With

Set SubItem = .Controls.Add(Type:=msoControlButton, temporary:=True)
With SubItem
.Caption = "next level later"
.OnAction = "AllenPark_155"
End With
End With

End Sub





Renato wrote:
>
> I currently running the following code to create a Custom Menu:
>
> Sub AddNewMenu()
> Dim HelpIndex As Integer
> Dim NewMenu As CommandBarPopup
>
> ' Get Index of Help menu
> HelpIndex = CommandBars(1).Controls("Help").Index
>
> ' Create the control
> Set NewMenu = CommandBars(1) _
> .Controls.Add(Type:=msoControlPopup, _
> Before:=HelpIndex, Temporary:=True)
> ' Add a caption
> NewMenu.Caption = "&Michigan154"
> End Sub
>
> Sub Allen()
> Dim Item As CommandBarControl
> Set Item = CommandBars(1).Controls("Michigan154") _
> .Controls.Add
> Item.Caption = "&Allen Park"
> Item.OnAction = "AllenPark_154"
> End Sub
>
> How can I add some submenus to this?
> Thanks

--

Dave Peterson