VBA: building submenus into a custom menu bar

[JaredSorensen]

I found a great piece of code on the web that allows a user to quickly and easily maintain a custom menu bar based upon a simple table that is built in the PERSONAL.XLS workbook.

However, I need help tweaking the code so that I can add submenus. I already have 26 items in the custom menu, and there are several more that I would like to add. Hence, I really need to incorporate submenus.

Following is the table that I built in the PERSONAL.xls workbook. The VBA code uses this table to flexibly construct a menu (titled 'Macros' that pops up before the Help dropdown on the top menu bar).

 Order 	 Menu Caption 	 OnAction Macro 	 Begin Group 	 FaceID 	 State 	 Enabled 
1	&Macros					
2	&Insert IsError	Insert_IsError				TRUE
3	Format in &Ones	Format_Ones_withComma_OneDecimal	TRUE			TRUE
4	Format in &Thousands	Format_000s_1decimal				TRUE
5	Format in &Millions	Format_Millions_1decimal				TRUE
6	Cond. Format &1: white font on red	Cond_Format_1_white_font_on_red	TRUE			TRUE
7	Cond. Format &0: white font	Cond_Format_0_white				TRUE
8	Alternate Rows: white/&grey	AlternatingRows				TRUE
9	Alternate &Rows: white/grey/blue	Alternating3Rows				TRUE
10	Delete All Conditional Formatting	DeleteCondFormatting				TRUE
11	&Deactivate Formulas	Insert_Apostrophe	TRUE			TRUE
12	&Activate Formulas	Delete_Apostrophe				TRUE
13	PageSetup - &Landscape	PageSetup_Landscape	TRUE			TRUE
14	PageSetup - &Portrait	PageSetup_Portrait				TRUE
15	Add &Footer (file and time)	footers_add				TRUE
16	D&elete Footer	footers_delete				TRUE
17	List All Tabs in &Workbook	List_All_Tab_Names	TRUE			TRUE
18	E&xtract Unique Items in List	List_Unique_Members				TRUE
19	Format &Chart	Uniform_Charts				TRUE
20	Special &Underline	Special_Underline				TRUE
21	Format &BusObject report	BO_reformat				TRUE
22	Delete MPC's leading &spaces	Delete_MPC_leading_spaces				TRUE
23	Perce&ntiles	Percentile_Add				TRUE
24	Un&hide all Tabs	UnhideSheets				TRUE
25	Print Screen&z	Print_Screen				TRUE
26	Delete Rows Meeting Criterion	DeleteRows_meeting_criterion				TRUE

And below is the code that runs every time I open an Excel instance.

Sub AddCustomMenu()
   'creates flexible menu system based on Excel table
   'By Charles Maxson
   'published on http://msdn2.microsoft.com/en-us/library/aa155718(office.10).aspx
   
   Dim cmbMenu As CommandBarPopup
   Dim cmbcMenuItem As CommandBarControl
   Dim rngMenu As Range
  
   ' Ensure menu doesn't already exist.
  RemoveMenus
  
   Set rngMenu = MenuTab.Range("CustomMenu")   ' Designate start of menu range.
         ' Add a new popup menu bar, set it to cmbMenu.
   Set cmbMenu = CommandBars("Worksheet Menu Bar"). _
    Controls.Add(Type:=msoControlPopup, _
    Before:=CommandBars("Worksheet Menu Bar") _
    .Controls.count)
   ' Set the caption of the new menu.
   With cmbMenu
    .Caption = rngMenu.Value
    .DescriptionText = rngMenu.Value & " Menu"
   End With
    ' *Move* down to the next row of the menu range.
   Set rngMenu = rngMenu.Offset(1, 0)
    ' Loop until the range is blank.
   Do Until rngMenu.Value = Empty
     ' Add a new menu bar button, set it to cmbcMenuItem.
     Set cmbcMenuItem = _
      cmbMenu.Controls.Add(Type:=msoControlButton)
     ' Set the properties of the button found in menu range.
     With cmbcMenuItem
      .Caption = rngMenu.Value
      .OnAction = rngMenu.Offset(0, 1).Value
      .BeginGroup = rngMenu.Offset(0, 2).Value
       If IsNumeric(rngMenu.Offset(0, 3).Value) Then
        .FaceId = rngMenu.Offset(0, 3).Value
       ElseIf rngMenu.Offset(0, 3).Value <> "" Then
        ThisWorkbook.Worksheets("wsWorking").Shapes _
           (rngMenu.Offset(0, 3).Value).Copy
        .PasteFace
       End If
      .State = rngMenu.Offset(0, 4).Value
      .Enabled = rngMenu.Offset(0, 5).Value
     End With
     ' *Move* down to the next row of the menu range.
     Set rngMenu = rngMenu.Offset(1, 0)
   Loop
   ' Release variables.
   Set rngMenu = Nothing
   Set cmbcMenuItem = Nothing
   Set cmbMenu = Nothing
End Sub
  
' Remove custom menu defined in CustomMenu range.
Sub RemoveMenus()
   On Error Resume Next
   ' Remove Menu Bar.
  CommandBars("Worksheet Menu Bar").Controls( _
    ThisWorkbook.Worksheets("wsWorking").Range( _
    "CustomMenu").Value).Delete
End Sub

Any ideas for how I could flexibly incorporate the option to build in a submenu? It would be great if I could add simply one more column to the table that I pasted; call the column 'Submenu?' and then let a "TRUE" make the corresponding row the submenu of the preceding row. I would then need some way to indicate that the code should jump back out of the submenu and return to the regular menu level.

Example: imagine you built a menu with 3 main items in the dropdown: Movies; Actors; Locations. If I had 4 movies I wanted to put in a submenu below "Movies", then I would want the first movie to be marked True for submenu column, and then movies 2-4 could be false (since the code would assume that it was in submenu mode until I indicated otherwise); the next row down would indicate "Actors" for which I could put "Back Up" in the submenu column to suggest I needed to jump back up a level. Make sense?

Any and all help would be appreciated. Thanks.

Jared

 

[xld]

Use this, it accomodates sub-menus

http://j-walk.com/ss/excel/tips/tip53.htm

 

[JaredSorensen]

This is exactly what I need. Thanks!

Jared