Solved: Menu maker

[mdmackillop]

My first real venture into Controls, but if you create subs to carry out the repetive items, it makes things a bit clearer. Maybe all the CCMs are not required, a bit of trial and error required.

[vba]Dim cbcCutomMenu As CommandBarControl

Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim Menu As CommandBarControl
Dim CCM1 As CommandBarControl
Dim CCM2 As CommandBarControl
Dim CCM3 As CommandBarControl
Dim CCM4 As CommandBarControl
Dim CCM5 As CommandBarControl

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&New Menu").Delete
On Error GoTo 0
Set cbMainMenuBar = _
Application.CommandBars("Worksheet Menu Bar")
iHelpMenu = _
cbMainMenuBar.Controls("Help").Index
Set cbcCutomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpMenu)
cbcCutomMenu.Caption = "&New Menu"

'Add initial controls
Call AddCont(cbcCutomMenu, "Menu 1", "MyMacro1")
Call AddCont(cbcCutomMenu, "Menu 2", "MyMacro2")
Call AddCont(cbcCutomMenu, "Menu 3", "MyMacro3")
Set CCM1 = cbcCutomMenu

'Insert first sub menu in chosen location
Call AddSub(CCM1, "Ne&xt Menu", 3)
Set CCM2 = cbcCutomMenu
'Add controls to first sub menu
Call AddCont(CCM2, "Menu 1", "MyMacro1")
Call AddCont(CCM2, "Menu 2", "MyMacro2")
Call AddCont(CCM2, "Menu 3", "MyMacro3")

'Add second sub menu
Call AddSub(CCM1, "Ne&xt Menu2", 4)
Set CCM3 = cbcCutomMenu
'Add controls to second sub menu
Call AddCont(CCM3, "Menu 1", "MyMacro1")
Call AddCont(CCM3, "Menu 2", "MyMacro2")

'Add sub level to first sub level
Call AddSub(CCM2, "Ne&xt Menu3", 3)
Set CCM3 = cbcCutomMenu
'Add controls
Call AddCont(CCM3, "Menu 1", "MyMacro1")
Call AddCont(CCM3, "Menu 2", "MyMacro2")

'Add second sub level to first sub level
Call AddSub(CCM2, "Ne&xt Menu", 2)
Set CCM4 = cbcCutomMenu
'Add controls
Call AddCont(CCM4, "Menu 1", "MyMacro1")
Call AddCont(CCM4, "&Charts", "MyMacro2")
Call AddCont(CCM4, "&Charts1", "MyMacro3")

End Sub


Sub AddSub(Menu, MyCap, Bef)
Set cbcCutomMenu = Menu.Controls.Add(Type:=msoControlPopup, Before:=Bef)
cbcCutomMenu.Caption = MyCap
End Sub

Sub AddCont(Menu, MyCap, MyAct)
With Menu.Controls.Add(Type:=msoControlButton)
.Caption = MyCap
.OnAction = MyAct
End With
End Sub



Sub DeleteMenu()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&New Menu").Delete
On Error GoTo 0
End Sub

Sub MyMacro1()
MsgBox "TEST?", vbInformation, "NUROFEN"
End Sub

Sub MyMacro2()
MsgBox "TEST2?", vbInformation, "NUROFEN"
End Sub

Sub MyMacro3()
MsgBox "TEST3?", vbInformation, "NUROFEN"
End Sub


[/vba]