Creating submenus....
 

Posted a load of nonsense earlier under Creating Submenus...


What I am actually need is this:


Using the following code to create a menu.........I need to amend the code
to allow for a second level of submenu to be created.


Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Befo=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption

Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId < "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True

Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId < "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select

Creating submenus....
 

try this...in a standard module...

Option Explicit
Sub Set_Menus()
Dim cmd As CommandBarPopup
Dim ctrl As CommandBarControl
Dim ctrldrop As CommandBarControl
Kill_Menus

With CommandBars("Worksheet Menu Bar")
Set cmd = .Controls.Add(msoControlPopup, _
befo=.Controls.Count, _
temporary:=True)
End With
cmd.Visible = True

With cmd
.Caption = "M&yTools"
With cmd.Controls.Add(msoControlButton)
.Caption = "Ctrl &1"
.Visible = True
.OnAction = "menu1"
End With
With .Controls.Add(msoControlPopup)
.Caption = "Subs 1"
With .Controls.Add(msoControlButton)
.Caption = "Sub1 &1"
.OnAction = "menu2"
End With
With .Controls.Add(msoControlButton)
.Caption = "Sub1 &2"
.OnAction = "menu2"
End With
End With
With .Controls.Add(msoControlPopup)
.Caption = "Subs 2"
With .Controls.Add(msoControlButton)
.Caption = "Sub2 &1"
.OnAction = "menu2"
End With
With .Controls.Add(msoControlButton)
.Caption = "Sub2 &2"
.OnAction = "menu2"
End With
End With
End With

Set cmd = Nothing

End Sub
Sub Kill_Menus()
On Error Resume Next
CommandBars("Worksheet Menu Bar").Controls("MyTools").Delete
On Error GoTo 0
End Sub
Sub menu1()
MsgBox "Menu 1"
End Sub
Sub menu2()
MsgBox "Menu 2"
End Sub




"Alan M" wrote:

Posted a load of nonsense earlier under Creating Submenus...


What I am actually need is this:


Using the following code to create a menu.........I need to amend the code
to allow for a second level of submenu to be created.


Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Befo=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption

Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId < "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True

Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId < "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select

Creating submenus....
 

See my response to your rubbish <vbg, it shows you how.

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Alan M" wrote in message
...
Posted a load of nonsense earlier under Creating Submenus...


What I am actually need is this:


Using the following code to create a menu.........I need to amend the code
to allow for a second level of submenu to be created.


Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Befo=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption

Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId < "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True

Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId < "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select