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, _
Befo=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, _
Befo=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