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/showpost.php?p=98738&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 :banghead:

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

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

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

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

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

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

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

[Nurofen]

Thank you Malcolm,

I didn't understand what you meant by "Can you have a caption and a FaceID?" sorry

I was trying to do it like


Sub AddCont(Menu, MyCap, MyAct,FaceId)
With Menu.Controls.Add(Type:=msoControlButton)
.Caption = MyCap
.OnAction = MyAct
End With
End Sub
it said the function was not defined, so I tried to put a Dim in but that didn't work either.


Thank you very much for helping

Your way way works great

Nurofen

[Nurofen]

I have been able to add Face Id to all menus with a Maco, but I can't with the non-Macro ones



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

End Sub


Thank for you time

Nurofen

[mdmackillop]

If Not IsMissing(FID) Then cbcCutomMenu.FaceId = FID

[Nurofen]

Hi,

I'm reall sorry about this but I can't get it to work, If you don't mind can you please give me a tip to what I'm doing wrong.



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

cbcCutomMenu.Caption = MyCap

End Sub

It allows me to run the code but no Face Id appears



Call AddSub(CCM1, "MM1", 420)
Set CCM2 = cbcCutomMenu

Thankyou for your time


Nurofen

[mdmackillop]

It appears you can add a FaceID and a Caption to a Control, but not to a Pop-Up. So you can use it the the AddCont lines, but not the AddSub lines.

Call AddCont(CCM5, "M2", "MyMacro2", 420)

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

[Aussiebear]

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

cbcCutomMenu.Caption = MyCap

End Sub


Would the spelling mistake in "cbcCutomMenu" be causing an issue?

[Nurofen]

Hi mdmackillop,

Thanks for clearing that up for me.

Thank you for your time

Nurofen


Hi Aussiebear,

Sure it has nothing to do with the spelling,
I'm guessing the code wouldn't have run in the first place if there was a spelling error.

Nurofen

[mdmackillop]

Hi Ted,
cbcCutomMenu is just a descriptive varable name. Any spelling will do, as long as it is consistent throughout the code. A misspelling of the declared variable would be picked up by using Option Explicit.

[Nurofen]

Hi mdmackillop,

I have a qustion is it wrong to put

'------------------------------------------------------------------
'Procedure Name(VBA) : Add Menu,Submenus and View One Sheet At A Time
'Date & Time : Date: Tuesday 9 October 2007 & Time: 02:58
'Author : Created by: Nurofen (the app)
'Purpose : My Company
'Comments : All Credit to Mdmackillop CodeAuthor,
for the menus
' : And Lucas for his help.
'-------------------------------------------------------------------

Thank you for your time

Nurofen

[mdmackillop]

Hi Nurofen,
I don't need any credit in the code. If you want to include a link to the question in VBAX, that might prove more useful.
Regards
MD

[Nurofen]

No Problem mdmackillop, I hope I didn't offend

I just think it better to ask then do.

Comments:Guide to commandbar menu creating http://vbaexpress.com/forum/newreply.php?do=newreply&noquote=1&p=118912

Thank you for your help and time

Nurofen

[mdmackillop]

No Problem, but try
http://vbaexpress.com/forum/showthread.php?t=15471

[Nurofen]

Mybad wrong link sorry.

Lucky I put it up first


Nurofen