Solved: Menu maker

[Nurofen]

Hi all,

I have found this Menumaker posted here by Lucas, Is possible that this great tool can be changed to make sub menus.


Thank you for your help


Nurofen

sorry I can't upload seems to a problem, I'll try and find the thread

[lucas]

http://www.vbaexpress.com/forum/show...8&postcount=12

[Nurofen]

Hi thats to fast,

The top link is the one, Is it possible to change it?

Even a tip or two will be helpful.


Thank you for your time
Nurofen

I have added the menu I've been working I just can't figure how to get the submenus on the submenus

[lucas]

This is the one that I use. I even use it in my addins:
http://j-walk.com/ss/excel/tips/tip53.htm

[Nurofen]

Hi,

How do I get it to set submenus on submenus. like
File
'
Open--Picture---Red
.........................'
.......................Blue


it's the red and blue part of the menu i'm having problems with

Thank you for you time

Nurofen

[lucas]

Try this

[Nurofen]

hi,

I seem to be confusing myself very badly here pulling out hair that I don't have.

I'm really having problems with putting these submenus to submenus.

I have attached a menu tree, if you could just guide me through please.

Thanking you for all time spent helping me

Nurofen

[lucas]

It is confusing but because you seem to be willing to work on it I'll try to get R1 set up if I don't run out of time and maybe you can sort the rest.

[Nurofen]

Thank you so much Lucas,

That will be a great help.

I've been on this for about 5hrs, and I can't figure out what i'm doing wrong.

Nurofen

Thank you again

[Nurofen]

I still can't get the submenu right, I have been trying and have got this close but again I'm at a road block..


Thank you for your time



Nurofen

[lucas]

Hi Nurofen,
I am having trouble with this too. I have never tried to go so deep into menu's before and it's harder than I thoght. Maybe someone else has more experience or can tell us why this is not working.....

[Nurofen]

Hi Lucas,

I have tried to understand the logic in the way the code is set but I'm just not getting it, I've tried other codes and they all seem to confuse me at the submenus. I can't seem to find a Structure as to how its set.

Thank you for taking your time in helping me Lucas.

If there is anyone who understands the structure of menus and submenu please if you don't mind taking some time to explain.


Thanking you for you time

Nurofen

[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]

[lucas]

Hi Malcolm....so glad you came along. I'm still having trouble understanding this. Could you look at the example of what the op is looking for in post#7

I having trouble getting more than one pop menu on each level....even using your fine example.

[mdmackillop]

[vba]Option Explicit

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
Dim CCM6 As CommandBarControl
Dim CCM7 As CommandBarControl
Dim CCM8 As CommandBarControl
Dim CCM9 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"

Set CCM1 = cbcCutomMenu
'Add initial controls
Call AddSub(CCM1, "R1")
Set CCM2 = cbcCutomMenu
Call AddSub(CCM1, "C1")
Set CCM3 = cbcCutomMenu
Call AddSub(CCM1, "W1")
Set CCM4 = cbcCutomMenu


Call AddSub(CCM2, "M2")
Set CCM5 = cbcCutomMenu
Call AddSub(CCM2, "S2")
Set CCM6 = cbcCutomMenu
Call AddSub(CCM2, "F2")
Set CCM7 = cbcCutomMenu
Call AddSub(CCM2, "Q2")
Set CCM8 = cbcCutomMenu

Call AddCont(CCM5, "M2", "MyMacro2")
Call AddCont(CCM5, "M3", "MyMacro3")

Call AddCont(CCM6, "S1", "MyMacro2")
Call AddCont(CCM6, "S2", "MyMacro3")

Call AddCont(CCM7, "F1", "MyMacro1")
Call AddCont(CCM7, "F2", "MyMacro2")
Call AddCont(CCM7, "F3", "MyMacro3")
End Sub

Sub AddSub(Menu, MyCap, Optional Bef)
If Not IsMissing(Bef) Then
Set cbcCutomMenu = Menu.Controls.Add(Type:=msoControlPopup, Before:=Bef)
Else
Set cbcCutomMenu = Menu.Controls.Add(Type:=msoControlPopup)
End If
cbcCutomMenu.Caption = MyCap
End Sub

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

[lucas]

That is phenomenal Malcolm. Thanks for taking the time to make it so easy to configure....

[mdmackillop]

Glad to help out Steve.

[Nurofen]

I would like to say a big Thankyou to Lucas and mdmackillop

Thank you for the time you both have put into this for me and others.

By looking at the how you have Structured your code mdmackillop I have been able to understand menus and submenus Thank you.


I have attached the file completed of the menu tree

Thank you

Nurofen

[Nurofen]

Hi Malcolm,

Could I please ask if I want to add Face ID how would I do that?



Thank you for your time

Nurofen

[mdmackillop]

Can you have a caption and a FaceID? If so then something like the following. If not, make the caption Optional in a similar fashion.

[vba]Call AddCont(CCM7, "F1", "MyMacro1", 420)

Sub AddCont(Menu, MyCap, MyAct, Optional FID)
With Menu.Controls.Add(Type:=msoControlButton)
.Caption = MyCap
If Not IsMissing(FID) Then .FaceId = FID
.OnAction = MyAct
End With
End Sub

[/vba] Note that the variables in AddCont etc should be properly dimmed to help avoid potential errors.