Creating sub menu in Command bar

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi all,

I would like to create a command bar that contains a menu with sub menues.
Do anyone know how to do this?

Menu
-------
Menu Item1
Menu Item2 -> Sub menu item -> Sub sub menu item

Regards
Anders
 
Function CreateMenu()

Dim HelpMenu As CommandBarControl
Dim MenuItem As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim SubMenuItem As CommandBarButton

Call DeleteMenu("TemplateMenuBar")

Set HelpMenu = CommandBars(1).FindControl(ID:=30010)

If HelpMenu Is Nothing Then

Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup,
temporary:=True)

Else

Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup,
Before:=HelpMenu.Index, temporary:=True)

End If

NewMenu.Caption = "TemplateMenuBar"


'------------------------------------------------------------------------------------------------------------------------

Set MenuItem = NewMenu.Controls.Add(Type:=msoControlButton)

With MenuItem

..Caption = "MenuItem1"
..OnAction = "Macro1"

End With


'------------------------------------------------------------------------------------------------------------------------

Set MenuItem = NewMenu.Controls.Add(Type:=msoControlPopup)

With MenuItem

..Caption = "MenuItem2"
..BeginGroup = True

End With


'------------------------------------------------------------------------------------------------------------------------

Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)

With SubMenuItem

..Caption = "MenuItem2a"
..OnAction = "Macro2a"

End With


'------------------------------------------------------------------------------------------------------------------------

Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)

With SubMenuItem

..Caption = "MenuItem2b"
..OnAction = "Macro2b"

End With

End Function
 
Hi Anders,
try this one:

Sub makemenewbar()
Set mynewbar = CommandBars(1).Controls.Add(Type:=msoControlPopup,
Temporary:=True)
With mynewbar
..Caption = "Name of new bar"
End With

Set button1 = mynewbar.Controls.Add(Type:=msoControlButton)
With button1
.Caption = "Button1"
.OnAction = "macro1"
End With

Set mysubmenu = mynewbar.Controls.Add(Type:=msoControlPopup)
With mysubmenu
.Caption = "Submenu1"
'.OnAction = "sheets_startuf"
End With

Set button2 = mysubmenu.Controls.Add(Type:=msoControlButton)
With button2
.Caption = "Button2 name"
.OnAction = "macro2"
End With

Set button3 = mysubmenu.Controls.Add(Type:=msoControlButton)
With button3
.Caption = "Button3 name"
.OnAction = "macro3"
End With
End Sub
 
Anders,

Here is an example

Sub PartsMenu()
Dim HelpMenu As CommandBarControl
Dim MainMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
Dim Submenuitem As CommandBarButton
' Deletes menu if it exits
Call DeleteMenu
' Find the help menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then
' Add the menu to the end
Set MainMenu = CommandBars(1).Controls. _
Add(Type:=msoControlPopup, temporary:=True)
Else
' Add menu before help
Set MainMenu = CommandBars(1).Controls. _
Add(Type:=msoControlPopup, before:=HelpMenu.Index, _
temporary:=True)
End If
' Add caption
MainMenu.Caption = "&Parts Utility"
' Searching for parts
Set MenuItem = MainMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Search Parts..."
.FaceId = 48
.ShortcutText = "Ctrl+Shift+S"
.OnAction = "SetupSearch"
End With
' LO / Remaining printout
Set MenuItem = MainMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Generate Parts Review..."
.FaceId = 285
.ShortcutText = "Ctrl+Shift+D"
.OnAction = "LORemaining"
End With
' View summary sheet
Set MenuItem = MainMenu.Controls.Add _
(Type:=msoControlPopup)
With MenuItem
.Caption = "Sub menu"
End With

Set Submenuitem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With Submenuitem
.Caption = "&View Summary..."
.FaceId = 592
.OnAction = "Summary"
End With
' Print summary sheet
Set Submenuitem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With Submenuitem
.Caption = "Print Summary"
' .Application = 364
.OnAction = "PrintSummary"
End With
End Sub

Sub DeleteMenu()
On Error Resume Next
Application.CommandBars(1).Controls("&Parts Utility").Delete
On Error GoTo 0
End Sub
 
For the sake of brevity, I only show how to:
1) Create a new toolbar
2) Add a popup type control (that supports menu items) to the toolbar
2) Add menu items to the popup control (menu control)
3) Add a popup control (that supports submenu items) to the first popup
control
4) Add submenu items to the second popup control
5) Use arrays and loops to drastically cut down on the code requirement.

You can continue the same branching process indefinately to my knowledge.

Regards,
Greg

Sub MakeNewMenu()
Dim CB As CommandBar
Dim NewMenu As CommandBarControl
Dim MenuItm As CommandBarControl
Dim SubMenuItm As CommandBarControl
Dim Arr1 As Variant, Arr2 As Variant
Dim Arr3 As Variant
Dim i As Integer

With Application
.ScreenUpdating = False
'Menu item caption list
Arr1 = Array("Caption 1", "Caption 2", _
"Caption 3", "Caption 4", "Caption 5")
'Menu item macro list
Arr2 = Array("Menu macro 1", "Menu macro 2", _
"Menu macro 3", "Menu macro 4", "Menu macro 5")
'Menu item FaceId list
Arr3 = Array(100, 101, 102, 103, 104)
Set CB = .CommandBars.Add("Data Analysis", Temporary:=True)
Set NewMenu = CB.Controls.Add(msoControlPopup)
NewMenu.Caption = "Menu items"
'ToolTipText supported on this level only
NewMenu.TooltipText = "Select from my macros"

'When referencing elements in an array, the first
'element has an index value of zero (hence 0 to 4)
For i = 0 To 4
Set MenuItm = NewMenu.Controls.Add
With MenuItm
.Caption = Arr1(i)
.Style = msoButtonIconAndCaption
.OnAction = Arr2(i)
.FaceId = Arr3(i)
End With
Next
'Submenu item caption list
Arr1 = Array("Caption 6", "Caption 7", "Caption 8", _
"Caption 9", "Caption 10")
'Submenu item macro list
Arr2 = Array("Submenu macro 1", "Submenu macro 2", _
"Submenu macro 3", "Submenu macro 4", "Submenu macro 5")
'Submenu item FaceId list
Arr3 = Array(200, 201, 202, 203, 204)
'Now add popup type control to support the submenus
Set MenuItm = NewMenu.Controls.Add(msoControlPopup)
MenuItm.Caption = "Sub menu items"
For i = 0 To 4
Set SubMenuItm = MenuItm.Controls.Add
With SubMenuItm
.Caption = Arr1(i)
.Style = msoButtonIconAndCaption
.OnAction = Arr2(i)
.FaceId = Arr3(i)
End With
Next
CB.Visible = True
DoEvents
.ScreenUpdating = True
End With
End Sub
 
Hi - first post so not sure if replying to a related thread is the best
way to post this question. Anyway:

On a related issue, I have set up menus with menu items (buotons,
popups, dropdowns,etc). I want to reference these controls elsewhere
(in different modules) and the variable names created with Set appear
to be lost (out of context). I can however refer to the controls index
number. Problem is I can only get index numbers (using FindControl) for
the controls at the menu level. It does not pickup menu items. Any way
around this? Thanks
 
If using xl2000 or later, use FindControls with an "s"

see Office VBA help for details.
 
Thanks Tom

FindControls only seems to work for all commandbars as follows (Office
VBA help as suggested):

"Set cntrls = CommandBars.FindControls(Type:=msoControlDropdown)"

but not on an individual commandbar such as:

"Set cntrls =
CommandBars("DTSheet").FindControls(Type:=msoControlDropdown)"

It replies with a "Method or data member not found".

Regards
Mick
 
This code looks like what I am after, but when I ran it I get an Error 5 at:

Set CBar = .CommandBars("myToolbar")

Does anyone know why? Do I need something outside of the below to get this
to work?
 
sounds like you don't have a toolbar called myToolbar

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Not sure if someone will still see this old post... I tried for a while to
make this sample run and finaly I could but how do I delete it when closing
the file... each time a run the file it creates a new comandbar called "Name
of new bar" and I can not delete it... I got my command bar full of them....
I need to close all my excel files to get ride of it... any idea?
 
Thanks for replying in the follow up of this old post... still not understand
how you get to pick all new posts or continuation of old post but you guys
have been very helpfull for me.

I did use
On Error Resume Next
CommandBars(1).Controls("Name of new bar").Delete
On Error GoTo 0

And was able to keep just one copy of it but still can not make it go away
when I close the file just go away when I close excel completely...
I have two questions...

HOW DO I DELETE IT BEFORE CLOSING THE FILE?
HOW DO I KEEP IT THERE EVEN BEFORE I CLOSE EXCEL? so it stays forever.
 
First.............To have the new bar for just the one workbook.............

In Thisworkbook module of the workbook in question.

'create bar on open
Private Sub Workbook_Open()
makemenewbar
End Sub

'delete bar on close
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
CommandBars(1).Controls("Name of new bar").Delete
On Error GoTo 0
End Sub

Second..................

If you want the new bar for all workbooks, place the Sub makemenewbar()
into your Personal.xls.

Also stick the code above into Thisworkbook module of Personal.xls.

Make sure Personal.xls also has the macros 1, 2, 3 etc. that are assigned to
the submenus.

Or stick everything into a new workbook and save it as an add-in.


Gord
 
It sounds intersting but you have introduce me to some new items for me....
please explain a little more.

you mentioned my personal.xls... what is it? how do I get it done?
add-in...? same, what is it? how do I get it done?

and.... since I am making a multi users program and I might install this new
command bar into others PC... just in case how will I remove if I follow
avobe proposals? I guess this will help me modify as well as needed.

Hope I am not asking too many basic questions.

I will review my actual coding because I think I already have first option
but it is not deleting the code before closing.

Thanks,
AA
 
Back
Top