Yes, I'm back again with another question about the menu macro.
In setting up the macros I found that I'm limited to 3 levels.
In general that's plenty, but I wanted to add a fourth level for a specific
set of macros.
What is involved in adding a fourth level to your menu macros?
I've tried the following:
At the "IF NextLevel = 3 Then" statement, I changed the number from 3 to 4
(thinking that it'd allow me to make a fourth level.); this did not work, and
instead called an error at the second line in the Case 3 ' A SubMenu Item
" Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)"
Thanks again for your time.

Can you post all the code?

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"SteveDB1" wrote in message
...
Yes, I'm back again with another question about the menu macro.
In setting up the macros I found that I'm limited to 3 levels.
In general that's plenty, but I wanted to add a fourth level for a
specific
set of macros.
What is involved in adding a fourth level to your menu macros?
I've tried the following:
At the "IF NextLevel = 3 Then" statement, I changed the number from 3 to 4
(thinking that it'd allow me to make a fourth level.); this did not work,
and
instead called an error at the second line in the Case 3 ' A SubMenu Item
" Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)"
Thanks again for your time.

Here's a menu system using John Walkenbach's technique of building a menu
from a worksheet listing.
It goes 6 levels deep but more can easily be added.
Hope this helps.


'/============================/
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' This sub will create up to 6 levels of menus using a
' worksheet with menu information as the template
' For more levels, use the same syntax as in Level 6 below.
'
'Col A - Level 1 thru 6 - REQUIRED
'Col B - Caption/Description of macro for the level - REQUIRED
'Col C - The macro name - REQUIRED
' Example: MyMacros.xls!MyTestMacro
'Col D - True/False - put a divider in the menu just
' before this macro - OPTIONAL
'Col E - FaceID - the icon displayed to the left of the
' caption - OPTIONAL
'Col F - True/False - is the Caption is visible on the menu
' - OPTIONAL
'Col G - True/False - is the macro enabled on the menu
' - OPTIONAL
'Col H - Shortcut Key assigned using 'Ctrl-Shift'
' Example: Col H contains an S
' MyMacros.xls!MyTestMacro is assigned Ctrl-Shift-S
'
Dim blnMacro As Boolean, blnEnabled As Boolean
Dim blnVisible As Boolean
Dim cbTopMenu As CommandBar
Dim cbbButton As CommandBarButton
' Dim SubMenuItem As CommandBarButton
' Dim MenuObject As CommandBarPopup
Dim cbpMenuLevel_1 As CommandBarPopup
Dim cbpMenuLevel_2 As CommandBarPopup
Dim cbpMenuLevel_3 As CommandBarPopup
Dim cbpMenuLevel_4 As CommandBarPopup
Dim cbpMenuLevel_5 As CommandBarPopup
Dim cbpMenuLevel_6 As CommandBarPopup
Dim iCommandBar As Long, iMaxLevel As Long
Dim iRow As Long, iLevel As Long
' Dim MenuItem As Object
Dim strWorksheetName As String
Dim Caption As Variant, Divider As Variant
Dim FaceId As Variant, MenuLevel As Variant
Dim Macro_Name As Variant, NextLevel As Variant
Dim ShortcutKeyPress As Variant
Dim varLevel As Variant
' dim varLevelPrior As Variant
Dim wkstMenuSheet As Worksheet

' On Error GoTo Err_Sub
strWorksheetName = "MenuSheet"
iCommandBar = 1
iMaxLevel = 10
blnMacro = True
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set wkstMenuSheet = ThisWorkbook.Sheets(strWorksheetName)
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Application.ScreenUpdating = False
Call DeleteMenu

' Initialize the row counter
iRow = 2

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

Do Until IsEmpty(wkstMenuSheet.Cells(iRow, 1))
blnMacro = True
blnEnabled = True
blnVisible = True
With wkstMenuSheet
MenuLevel = .Cells(iRow, 1)
Caption = .Cells(iRow, 2)
Macro_Name = .Cells(iRow, 3)
Divider = .Cells(iRow, 4)
FaceId = .Cells(iRow, 5)
blnVisible = .Cells(iRow, 6)
If Len(.Cells(iRow, 7)) < 0 Then
If UCase(.Cells(iRow, 7)) = True Or _
UCase(.Cells(iRow, 7)) = False Then
blnEnabled = .Cells(iRow, 7)
End If
End If
ShortcutKeyPress = .Cells(iRow, 8)
NextLevel = .Cells(iRow + 1, 1)
End With

'check if menu items are layered correctly in worksheet
If wkstMenuSheet.Cells(iRow - 1, 1) < MenuLevel - 1 _
And MenuLevel < 1 Then
'a level has been skipped, menu won't work
MsgBox _
"A level has been skipped in the Menu worksheet." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check if menu level is 10 - this program will
' only function thru
' 10 levels of menus
If MenuLevel 10 Then
MsgBox "This menu exceeds maximum menu levels." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check that menu level is 0
If Not _
Application.WorksheetFunction.IsNumber(MenuLevel) Then
MsgBox "The menu levels entered in the Menu " & _
"worksheet are not all numbers." & vbCr & _
"The menu is being deleted.", vbCritical + vbOKOnly, _
"Warning..."
GoTo err_Sub
End If

If blnVisible Then
'set up levels - create menu level by level
If MenuLevel = 1 Then
Macro_Name = _
CommandBars(iCommandBar).Controls.Count - 2
Set cbTopMenu = Application.CommandBars(iCommandBar)
Set cbpMenuLevel_1 = _
cbTopMenu.Controls.Add(Type:=msoControlPopup, _
Befo=Macro_Name, _
Temporary:=True)
cbpMenuLevel_1.Caption = Caption
cbpMenuLevel_1.Visible = True

Else ' A Menu Item
If Len(Macro_Name) = 0 Then
blnMacro = False
End If
Select Case MenuLevel
Case 2
If blnMacro = False Then
Set cbpMenuLevel_2 = _
cbpMenuLevel_1.Controls.Add(msoControlPopup)
cbpMenuLevel_2.Caption = Caption
If Divider Then cbpMenuLevel_2.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_2.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_1.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 3
If blnMacro = False Then
Set cbpMenuLevel_3 = _
cbpMenuLevel_2.Controls.Add(msoControlPopup)
cbpMenuLevel_3.Caption = Caption
If Divider Then cbpMenuLevel_3.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_3.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_2.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 4
If blnMacro = False Then
Set cbpMenuLevel_4 = _
cbpMenuLevel_3.Controls.Add(msoControlPopup)
cbpMenuLevel_4.Caption = Caption
If Divider Then cbpMenuLevel_4.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_4.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_3.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 5
If blnMacro = False Then
Set cbpMenuLevel_5 = _
cbpMenuLevel_4.Controls.Add(msoControlPopup)
cbpMenuLevel_5.Caption = Caption
If Divider Then cbpMenuLevel_5.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_5.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_4.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 6
If blnMacro = False Then
Set cbpMenuLevel_6 = _
cbpMenuLevel_5.Controls.Add(msoControlPopup)
cbpMenuLevel_6.Caption = Caption
If Divider Then cbpMenuLevel_6.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_6.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_5.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
End Select

End If
End If
iRow = iRow + 1
Loop

exit_Sub:
On Error Resume Next
Application.ScreenUpdating = True

' For iLevel = 10 To 1 Step -1
' varLevel = "cbpMenuLevel_" & iLevel
' Set varLevel = Nothing
' Next iLevel
'
' Set cbTopMenu = Nothing
Exit Sub

err_Sub:
Call DeleteMenu
GoTo exit_Sub

End Sub

'/============================/
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes Menus on top CommandBar that are on the template
' worksheet "MenuSheet"
Dim wkstMenuSheet As Worksheet
Dim iRow As Long, iCommandBar As Long
Dim strCaption As String, strMenuWorksheet As String

On Error Resume Next

' - - - - V A R I A B L E S - - - - - - -
iCommandBar = 1
strMenuWorksheet = "MenuSheet"
' - - - - - - - - - - - - - - - - - - - -

Set wkstMenuSheet = ThisWorkbook.Sheets(strMenuWorksheet)

iRow = 2

Do Until IsEmpty(wkstMenuSheet.Cells(iRow, 1))
If wkstMenuSheet.Cells(iRow, 1) = 1 Then
strCaption = wkstMenuSheet.Cells(iRow, 2)
Application.CommandBars(iCommandBar).Controls(strC aption).Delete
End If
iRow = iRow + 1
Loop
On Error GoTo 0
End Sub
'/============================/


--
HTH,
Gary Brown

If this post was helpful to you, please select ''YES'' at the bottom of the
post.



"SteveDB1" wrote:

Yes, I'm back again with another question about the menu macro.
In setting up the macros I found that I'm limited to 3 levels.
In general that's plenty, but I wanted to add a fourth level for a specific
set of macros.
What is involved in adding a fourth level to your menu macros?
I've tried the following:
At the "IF NextLevel = 3 Then" statement, I changed the number from 3 to 4
(thinking that it'd allow me to make a fourth level.); this did not work, and
instead called an error at the second line in the Case 3 ' A SubMenu Item
" Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)"
Thanks again for your time.

Sure,
Here it is:
------------------------------------------------------------------------------------
Sub CreatePopUp()
' NOTE: There is no error handling in this subroutine

Dim MenuSheet As Worksheet
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, MacroName, Caption, Divider, FaceId

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set MenuSheet = ThisWorkbook.sheets("MenuSheet")
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Call RemovePopUp

' Initialize the row counter
Row = 5

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

' First we have create a PopUp menu with the name of the value in B2
With Application.CommandBars.Add(ThisWorkbook.sheets("M enuSheet"). _
Range("B2").Value, msoBarPopup, False,
True)

Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
MacroName = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With

Select Case MenuLevel
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem = .Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = .Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
End If
MenuItem.Caption = Caption
If FaceId < "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True

Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
If FaceId < "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End With
End Sub
-----------------------------------------------------------------------------------

"Bob Phillips" wrote:

Can you post all the code?

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"SteveDB1" wrote in message
...
Yes, I'm back again with another question about the menu macro.
In setting up the macros I found that I'm limited to 3 levels.
In general that's plenty, but I wanted to add a fourth level for a
specific
set of macros.
What is involved in adding a fourth level to your menu macros?
I've tried the following:
At the "IF NextLevel = 3 Then" statement, I changed the number from 3 to 4
(thinking that it'd allow me to make a fourth level.); this did not work,
and
instead called an error at the second line in the Case 3 ' A SubMenu Item
" Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)"
Thanks again for your time.

hi Gary,
Thanks.
Will this work in Excel 2007?


"Gary Brown" wrote:

Here's a menu system using John Walkenbach's technique of building a menu
from a worksheet listing.
It goes 6 levels deep but more can easily be added.
Hope this helps.


'/============================/
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' This sub will create up to 6 levels of menus using a
' worksheet with menu information as the template
' For more levels, use the same syntax as in Level 6 below.
'
'Col A - Level 1 thru 6 - REQUIRED
'Col B - Caption/Description of macro for the level - REQUIRED
'Col C - The macro name - REQUIRED
' Example: MyMacros.xls!MyTestMacro
'Col D - True/False - put a divider in the menu just
' before this macro - OPTIONAL
'Col E - FaceID - the icon displayed to the left of the
' caption - OPTIONAL
'Col F - True/False - is the Caption is visible on the menu
' - OPTIONAL
'Col G - True/False - is the macro enabled on the menu
' - OPTIONAL
'Col H - Shortcut Key assigned using 'Ctrl-Shift'
' Example: Col H contains an S
' MyMacros.xls!MyTestMacro is assigned Ctrl-Shift-S
'
Dim blnMacro As Boolean, blnEnabled As Boolean
Dim blnVisible As Boolean
Dim cbTopMenu As CommandBar
Dim cbbButton As CommandBarButton
' Dim SubMenuItem As CommandBarButton
' Dim MenuObject As CommandBarPopup
Dim cbpMenuLevel_1 As CommandBarPopup
Dim cbpMenuLevel_2 As CommandBarPopup
Dim cbpMenuLevel_3 As CommandBarPopup
Dim cbpMenuLevel_4 As CommandBarPopup
Dim cbpMenuLevel_5 As CommandBarPopup
Dim cbpMenuLevel_6 As CommandBarPopup
Dim iCommandBar As Long, iMaxLevel As Long
Dim iRow As Long, iLevel As Long
' Dim MenuItem As Object
Dim strWorksheetName As String
Dim Caption As Variant, Divider As Variant
Dim FaceId As Variant, MenuLevel As Variant
Dim Macro_Name As Variant, NextLevel As Variant
Dim ShortcutKeyPress As Variant
Dim varLevel As Variant
' dim varLevelPrior As Variant
Dim wkstMenuSheet As Worksheet

' On Error GoTo Err_Sub
strWorksheetName = "MenuSheet"
iCommandBar = 1
iMaxLevel = 10
blnMacro = True
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set wkstMenuSheet = ThisWorkbook.Sheets(strWorksheetName)
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Application.ScreenUpdating = False
Call DeleteMenu

' Initialize the row counter
iRow = 2

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

Do Until IsEmpty(wkstMenuSheet.Cells(iRow, 1))
blnMacro = True
blnEnabled = True
blnVisible = True
With wkstMenuSheet
MenuLevel = .Cells(iRow, 1)
Caption = .Cells(iRow, 2)
Macro_Name = .Cells(iRow, 3)
Divider = .Cells(iRow, 4)
FaceId = .Cells(iRow, 5)
blnVisible = .Cells(iRow, 6)
If Len(.Cells(iRow, 7)) < 0 Then
If UCase(.Cells(iRow, 7)) = True Or _
UCase(.Cells(iRow, 7)) = False Then
blnEnabled = .Cells(iRow, 7)
End If
End If
ShortcutKeyPress = .Cells(iRow, 8)
NextLevel = .Cells(iRow + 1, 1)
End With

'check if menu items are layered correctly in worksheet
If wkstMenuSheet.Cells(iRow - 1, 1) < MenuLevel - 1 _
And MenuLevel < 1 Then
'a level has been skipped, menu won't work
MsgBox _
"A level has been skipped in the Menu worksheet." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check if menu level is 10 - this program will
' only function thru
' 10 levels of menus
If MenuLevel 10 Then
MsgBox "This menu exceeds maximum menu levels." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check that menu level is 0
If Not _
Application.WorksheetFunction.IsNumber(MenuLevel) Then
MsgBox "The menu levels entered in the Menu " & _
"worksheet are not all numbers." & vbCr & _
"The menu is being deleted.", vbCritical + vbOKOnly, _
"Warning..."
GoTo err_Sub
End If

If blnVisible Then
'set up levels - create menu level by level
If MenuLevel = 1 Then
Macro_Name = _
CommandBars(iCommandBar).Controls.Count - 2
Set cbTopMenu = Application.CommandBars(iCommandBar)
Set cbpMenuLevel_1 = _
cbTopMenu.Controls.Add(Type:=msoControlPopup, _
Befo=Macro_Name, _
Temporary:=True)
cbpMenuLevel_1.Caption = Caption
cbpMenuLevel_1.Visible = True

Else ' A Menu Item
If Len(Macro_Name) = 0 Then
blnMacro = False
End If
Select Case MenuLevel
Case 2
If blnMacro = False Then
Set cbpMenuLevel_2 = _
cbpMenuLevel_1.Controls.Add(msoControlPopup)
cbpMenuLevel_2.Caption = Caption
If Divider Then cbpMenuLevel_2.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_2.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_1.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 3
If blnMacro = False Then
Set cbpMenuLevel_3 = _
cbpMenuLevel_2.Controls.Add(msoControlPopup)
cbpMenuLevel_3.Caption = Caption
If Divider Then cbpMenuLevel_3.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_3.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_2.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 4
If blnMacro = False Then
Set cbpMenuLevel_4 = _
cbpMenuLevel_3.Controls.Add(msoControlPopup)
cbpMenuLevel_4.Caption = Caption
If Divider Then cbpMenuLevel_4.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_4.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_3.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 5
If blnMacro = False Then
Set cbpMenuLevel_5 = _
cbpMenuLevel_4.Controls.Add(msoControlPopup)
cbpMenuLevel_5.Caption = Caption
If Divider Then cbpMenuLevel_5.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_5.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_4.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 6
If blnMacro = False Then
Set cbpMenuLevel_6 = _
cbpMenuLevel_5.Controls.Add(msoControlPopup)
cbpMenuLevel_6.Caption = Caption
If Divider Then cbpMenuLevel_6.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_6.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_5.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
End Select

End If
End If
iRow = iRow + 1
Loop

exit_Sub:
On Error Resume Next
Application.ScreenUpdating = True

' For iLevel = 10 To 1 Step -1
' varLevel = "cbpMenuLevel_" & iLevel
' Set varLevel = Nothing
' Next iLevel
'
' Set cbTopMenu = Nothing
Exit Sub

err_Sub:
Call DeleteMenu
GoTo exit_Sub

End Sub

'/============================/
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes Menus on top CommandBar that are on the template
' worksheet "MenuSheet"
Dim wkstMenuSheet As Worksheet
Dim iRow As Long, iCommandBar As Long

No idea and hope I never need to find out!
But I'm pretty sure it won't.
Sorry.
--
HTH,
Gary Brown

If this post was helpful to you, please select ''YES'' at the bottom of the
post.



"SteveDB1" wrote:

hi Gary,
Thanks.
Will this work in Excel 2007?


"Gary Brown" wrote:

Here's a menu system using John Walkenbach's technique of building a menu
from a worksheet listing.
It goes 6 levels deep but more can easily be added.
Hope this helps.


'/============================/
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' This sub will create up to 6 levels of menus using a
' worksheet with menu information as the template
' For more levels, use the same syntax as in Level 6 below.
'
'Col A - Level 1 thru 6 - REQUIRED
'Col B - Caption/Description of macro for the level - REQUIRED
'Col C - The macro name - REQUIRED
' Example: MyMacros.xls!MyTestMacro
'Col D - True/False - put a divider in the menu just
' before this macro - OPTIONAL
'Col E - FaceID - the icon displayed to the left of the
' caption - OPTIONAL
'Col F - True/False - is the Caption is visible on the menu
' - OPTIONAL
'Col G - True/False - is the macro enabled on the menu
' - OPTIONAL
'Col H - Shortcut Key assigned using 'Ctrl-Shift'
' Example: Col H contains an S
' MyMacros.xls!MyTestMacro is assigned Ctrl-Shift-S
'
Dim blnMacro As Boolean, blnEnabled As Boolean
Dim blnVisible As Boolean
Dim cbTopMenu As CommandBar
Dim cbbButton As CommandBarButton
' Dim SubMenuItem As CommandBarButton
' Dim MenuObject As CommandBarPopup
Dim cbpMenuLevel_1 As CommandBarPopup
Dim cbpMenuLevel_2 As CommandBarPopup
Dim cbpMenuLevel_3 As CommandBarPopup
Dim cbpMenuLevel_4 As CommandBarPopup
Dim cbpMenuLevel_5 As CommandBarPopup
Dim cbpMenuLevel_6 As CommandBarPopup
Dim iCommandBar As Long, iMaxLevel As Long
Dim iRow As Long, iLevel As Long
' Dim MenuItem As Object
Dim strWorksheetName As String
Dim Caption As Variant, Divider As Variant
Dim FaceId As Variant, MenuLevel As Variant
Dim Macro_Name As Variant, NextLevel As Variant
Dim ShortcutKeyPress As Variant
Dim varLevel As Variant
' dim varLevelPrior As Variant
Dim wkstMenuSheet As Worksheet

' On Error GoTo Err_Sub
strWorksheetName = "MenuSheet"
iCommandBar = 1
iMaxLevel = 10
blnMacro = True
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set wkstMenuSheet = ThisWorkbook.Sheets(strWorksheetName)
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Application.ScreenUpdating = False
Call DeleteMenu

' Initialize the row counter
iRow = 2

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

Do Until IsEmpty(wkstMenuSheet.Cells(iRow, 1))
blnMacro = True
blnEnabled = True
blnVisible = True
With wkstMenuSheet
MenuLevel = .Cells(iRow, 1)
Caption = .Cells(iRow, 2)
Macro_Name = .Cells(iRow, 3)
Divider = .Cells(iRow, 4)
FaceId = .Cells(iRow, 5)
blnVisible = .Cells(iRow, 6)
If Len(.Cells(iRow, 7)) < 0 Then
If UCase(.Cells(iRow, 7)) = True Or _
UCase(.Cells(iRow, 7)) = False Then
blnEnabled = .Cells(iRow, 7)
End If
End If
ShortcutKeyPress = .Cells(iRow, 8)
NextLevel = .Cells(iRow + 1, 1)
End With

'check if menu items are layered correctly in worksheet
If wkstMenuSheet.Cells(iRow - 1, 1) < MenuLevel - 1 _
And MenuLevel < 1 Then
'a level has been skipped, menu won't work
MsgBox _
"A level has been skipped in the Menu worksheet." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check if menu level is 10 - this program will
' only function thru
' 10 levels of menus
If MenuLevel 10 Then
MsgBox "This menu exceeds maximum menu levels." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check that menu level is 0
If Not _
Application.WorksheetFunction.IsNumber(MenuLevel) Then
MsgBox "The menu levels entered in the Menu " & _
"worksheet are not all numbers." & vbCr & _
"The menu is being deleted.", vbCritical + vbOKOnly, _
"Warning..."
GoTo err_Sub
End If

If blnVisible Then
'set up levels - create menu level by level
If MenuLevel = 1 Then
Macro_Name = _
CommandBars(iCommandBar).Controls.Count - 2
Set cbTopMenu = Application.CommandBars(iCommandBar)
Set cbpMenuLevel_1 = _
cbTopMenu.Controls.Add(Type:=msoControlPopup, _
Befo=Macro_Name, _
Temporary:=True)
cbpMenuLevel_1.Caption = Caption
cbpMenuLevel_1.Visible = True

Else ' A Menu Item
If Len(Macro_Name) = 0 Then
blnMacro = False
End If
Select Case MenuLevel
Case 2
If blnMacro = False Then
Set cbpMenuLevel_2 = _
cbpMenuLevel_1.Controls.Add(msoControlPopup)
cbpMenuLevel_2.Caption = Caption
If Divider Then cbpMenuLevel_2.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_2.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_1.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 3
If blnMacro = False Then
Set cbpMenuLevel_3 = _
cbpMenuLevel_2.Controls.Add(msoControlPopup)
cbpMenuLevel_3.Caption = Caption
If Divider Then cbpMenuLevel_3.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_3.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_2.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 4
If blnMacro = False Then
Set cbpMenuLevel_4 = _
cbpMenuLevel_3.Controls.Add(msoControlPopup)
cbpMenuLevel_4.Caption = Caption
If Divider Then cbpMenuLevel_4.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_4.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_3.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 5
If blnMacro = False Then
Set cbpMenuLevel_5 = _
cbpMenuLevel_4.Controls.Add(msoControlPopup)
cbpMenuLevel_5.Caption = Caption
If Divider Then cbpMenuLevel_5.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_5.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_4.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 6
If blnMacro = False Then
Set cbpMenuLevel_6 = _
cbpMenuLevel_5.Controls.Add(msoControlPopup)
cbpMenuLevel_6.Caption = Caption
If Divider Then cbpMenuLevel_6.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_6.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_5.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
End Select

End If
End If
iRow = iRow + 1
Loop

exit_Sub:
On Error Resume Next
Application.ScreenUpdating = True

' For iLevel = 10 To 1 Step -1
' varLevel = "cbpMenuLevel_" & iLevel
' Set varLevel = Nothing
' Next iLevel
'
' Set cbTopMenu = Nothing
Exit Sub

err_Sub:
Call DeleteMenu
GoTo exit_Sub

End Sub

Try it and see.
If your sample code works then this should work.
--
HTH,
Gary Brown

If this post was helpful to you, please select ''YES'' at the bottom of the
post.



"Gary Brown" wrote:

No idea and hope I never need to find out!
But I'm pretty sure it won't.
Sorry.
--
HTH,
Gary Brown

If this post was helpful to you, please select ''YES'' at the bottom of the
post.



"SteveDB1" wrote:

hi Gary,
Thanks.
Will this work in Excel 2007?


"Gary Brown" wrote:

Here's a menu system using John Walkenbach's technique of building a menu
from a worksheet listing.
It goes 6 levels deep but more can easily be added.
Hope this helps.


'/============================/
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' This sub will create up to 6 levels of menus using a
' worksheet with menu information as the template
' For more levels, use the same syntax as in Level 6 below.
'
'Col A - Level 1 thru 6 - REQUIRED
'Col B - Caption/Description of macro for the level - REQUIRED
'Col C - The macro name - REQUIRED
' Example: MyMacros.xls!MyTestMacro
'Col D - True/False - put a divider in the menu just
' before this macro - OPTIONAL
'Col E - FaceID - the icon displayed to the left of the
' caption - OPTIONAL
'Col F - True/False - is the Caption is visible on the menu
' - OPTIONAL
'Col G - True/False - is the macro enabled on the menu
' - OPTIONAL
'Col H - Shortcut Key assigned using 'Ctrl-Shift'
' Example: Col H contains an S
' MyMacros.xls!MyTestMacro is assigned Ctrl-Shift-S
'
Dim blnMacro As Boolean, blnEnabled As Boolean
Dim blnVisible As Boolean
Dim cbTopMenu As CommandBar
Dim cbbButton As CommandBarButton
' Dim SubMenuItem As CommandBarButton
' Dim MenuObject As CommandBarPopup
Dim cbpMenuLevel_1 As CommandBarPopup
Dim cbpMenuLevel_2 As CommandBarPopup
Dim cbpMenuLevel_3 As CommandBarPopup
Dim cbpMenuLevel_4 As CommandBarPopup
Dim cbpMenuLevel_5 As CommandBarPopup
Dim cbpMenuLevel_6 As CommandBarPopup
Dim iCommandBar As Long, iMaxLevel As Long
Dim iRow As Long, iLevel As Long
' Dim MenuItem As Object
Dim strWorksheetName As String
Dim Caption As Variant, Divider As Variant
Dim FaceId As Variant, MenuLevel As Variant
Dim Macro_Name As Variant, NextLevel As Variant
Dim ShortcutKeyPress As Variant
Dim varLevel As Variant
' dim varLevelPrior As Variant
Dim wkstMenuSheet As Worksheet

' On Error GoTo Err_Sub
strWorksheetName = "MenuSheet"
iCommandBar = 1
iMaxLevel = 10
blnMacro = True
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set wkstMenuSheet = ThisWorkbook.Sheets(strWorksheetName)
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Application.ScreenUpdating = False
Call DeleteMenu

' Initialize the row counter
iRow = 2

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

Do Until IsEmpty(wkstMenuSheet.Cells(iRow, 1))
blnMacro = True
blnEnabled = True
blnVisible = True
With wkstMenuSheet
MenuLevel = .Cells(iRow, 1)
Caption = .Cells(iRow, 2)
Macro_Name = .Cells(iRow, 3)
Divider = .Cells(iRow, 4)
FaceId = .Cells(iRow, 5)
blnVisible = .Cells(iRow, 6)
If Len(.Cells(iRow, 7)) < 0 Then
If UCase(.Cells(iRow, 7)) = True Or _
UCase(.Cells(iRow, 7)) = False Then
blnEnabled = .Cells(iRow, 7)
End If
End If
ShortcutKeyPress = .Cells(iRow, 8)
NextLevel = .Cells(iRow + 1, 1)
End With

'check if menu items are layered correctly in worksheet
If wkstMenuSheet.Cells(iRow - 1, 1) < MenuLevel - 1 _
And MenuLevel < 1 Then
'a level has been skipped, menu won't work
MsgBox _
"A level has been skipped in the Menu worksheet." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check if menu level is 10 - this program will
' only function thru
' 10 levels of menus
If MenuLevel 10 Then
MsgBox "This menu exceeds maximum menu levels." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check that menu level is 0
If Not _
Application.WorksheetFunction.IsNumber(MenuLevel) Then
MsgBox "The menu levels entered in the Menu " & _
"worksheet are not all numbers." & vbCr & _
"The menu is being deleted.", vbCritical + vbOKOnly, _
"Warning..."
GoTo err_Sub
End If

If blnVisible Then
'set up levels - create menu level by level
If MenuLevel = 1 Then
Macro_Name = _
CommandBars(iCommandBar).Controls.Count - 2
Set cbTopMenu = Application.CommandBars(iCommandBar)
Set cbpMenuLevel_1 = _
cbTopMenu.Controls.Add(Type:=msoControlPopup, _
Befo=Macro_Name, _
Temporary:=True)
cbpMenuLevel_1.Caption = Caption
cbpMenuLevel_1.Visible = True

Else ' A Menu Item
If Len(Macro_Name) = 0 Then
blnMacro = False
End If
Select Case MenuLevel
Case 2
If blnMacro = False Then
Set cbpMenuLevel_2 = _
cbpMenuLevel_1.Controls.Add(msoControlPopup)
cbpMenuLevel_2.Caption = Caption
If Divider Then cbpMenuLevel_2.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_2.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_1.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 3
If blnMacro = False Then
Set cbpMenuLevel_3 = _
cbpMenuLevel_2.Controls.Add(msoControlPopup)
cbpMenuLevel_3.Caption = Caption
If Divider Then cbpMenuLevel_3.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_3.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_2.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 4
If blnMacro = False Then
Set cbpMenuLevel_4 = _
cbpMenuLevel_3.Controls.Add(msoControlPopup)
cbpMenuLevel_4.Caption = Caption
If Divider Then cbpMenuLevel_4.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_4.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_3.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 5
If blnMacro = False Then
Set cbpMenuLevel_5 = _
cbpMenuLevel_4.Controls.Add(msoControlPopup)
cbpMenuLevel_5.Caption = Caption
If Divider Then cbpMenuLevel_5.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_5.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_4.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 6
If blnMacro = False Then
Set cbpMenuLevel_6 = _
cbpMenuLevel_5.Controls.Add(msoControlPopup)
cbpMenuLevel_6.Caption = Caption
If Divider Then cbpMenuLevel_6.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_6.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_5.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
End Select

End If
End If
iRow = iRow + 1
Loop

exit_Sub:
On Error Resume Next
Application.ScreenUpdating = True

Steve,

2007 is very different, you have the ribbon rather than commandbars.

Ron has some pages for amending the ribbon at
http://www.rondebruin.nl/ribbon.htm. Not tried these pages myself, so I have
no idea of what they do, but levels don't really come into the ribbon.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"SteveDB1" wrote in message
...
hi Gary,
Thanks.
Will this work in Excel 2007?


"Gary Brown" wrote:

Here's a menu system using John Walkenbach's technique of building a menu
from a worksheet listing.
It goes 6 levels deep but more can easily be added.
Hope this helps.


'/============================/
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' This sub will create up to 6 levels of menus using a
' worksheet with menu information as the template
' For more levels, use the same syntax as in Level 6 below.
'
'Col A - Level 1 thru 6 - REQUIRED
'Col B - Caption/Description of macro for the level - REQUIRED
'Col C - The macro name - REQUIRED
' Example: MyMacros.xls!MyTestMacro
'Col D - True/False - put a divider in the menu just
' before this macro - OPTIONAL
'Col E - FaceID - the icon displayed to the left of the
' caption - OPTIONAL
'Col F - True/False - is the Caption is visible on the menu
' - OPTIONAL
'Col G - True/False - is the macro enabled on the menu
' - OPTIONAL
'Col H - Shortcut Key assigned using 'Ctrl-Shift'
' Example: Col H contains an S
' MyMacros.xls!MyTestMacro is assigned Ctrl-Shift-S
'
Dim blnMacro As Boolean, blnEnabled As Boolean
Dim blnVisible As Boolean
Dim cbTopMenu As CommandBar
Dim cbbButton As CommandBarButton
' Dim SubMenuItem As CommandBarButton
' Dim MenuObject As CommandBarPopup
Dim cbpMenuLevel_1 As CommandBarPopup
Dim cbpMenuLevel_2 As CommandBarPopup
Dim cbpMenuLevel_3 As CommandBarPopup
Dim cbpMenuLevel_4 As CommandBarPopup
Dim cbpMenuLevel_5 As CommandBarPopup
Dim cbpMenuLevel_6 As CommandBarPopup
Dim iCommandBar As Long, iMaxLevel As Long
Dim iRow As Long, iLevel As Long
' Dim MenuItem As Object
Dim strWorksheetName As String
Dim Caption As Variant, Divider As Variant
Dim FaceId As Variant, MenuLevel As Variant
Dim Macro_Name As Variant, NextLevel As Variant
Dim ShortcutKeyPress As Variant
Dim varLevel As Variant
' dim varLevelPrior As Variant
Dim wkstMenuSheet As Worksheet

' On Error GoTo Err_Sub
strWorksheetName = "MenuSheet"
iCommandBar = 1
iMaxLevel = 10
blnMacro = True
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set wkstMenuSheet = ThisWorkbook.Sheets(strWorksheetName)
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Application.ScreenUpdating = False
Call DeleteMenu

' Initialize the row counter
iRow = 2

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

Do Until IsEmpty(wkstMenuSheet.Cells(iRow, 1))
blnMacro = True
blnEnabled = True
blnVisible = True
With wkstMenuSheet
MenuLevel = .Cells(iRow, 1)
Caption = .Cells(iRow, 2)
Macro_Name = .Cells(iRow, 3)
Divider = .Cells(iRow, 4)
FaceId = .Cells(iRow, 5)
blnVisible = .Cells(iRow, 6)
If Len(.Cells(iRow, 7)) < 0 Then
If UCase(.Cells(iRow, 7)) = True Or _
UCase(.Cells(iRow, 7)) = False Then
blnEnabled = .Cells(iRow, 7)
End If
End If
ShortcutKeyPress = .Cells(iRow, 8)
NextLevel = .Cells(iRow + 1, 1)
End With

'check if menu items are layered correctly in worksheet
If wkstMenuSheet.Cells(iRow - 1, 1) < MenuLevel - 1 _
And MenuLevel < 1 Then
'a level has been skipped, menu won't work
MsgBox _
"A level has been skipped in the Menu worksheet." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check if menu level is 10 - this program will
' only function thru
' 10 levels of menus
If MenuLevel 10 Then
MsgBox "This menu exceeds maximum menu levels." & _
vbCr & "The menu is being deleted.", vbCritical + _
vbOKOnly, "Warning..."
GoTo err_Sub
End If

'check that menu level is 0
If Not _
Application.WorksheetFunction.IsNumber(MenuLevel) Then
MsgBox "The menu levels entered in the Menu " & _
"worksheet are not all numbers." & vbCr & _
"The menu is being deleted.", vbCritical + vbOKOnly, _
"Warning..."
GoTo err_Sub
End If

If blnVisible Then
'set up levels - create menu level by level
If MenuLevel = 1 Then
Macro_Name = _
CommandBars(iCommandBar).Controls.Count - 2
Set cbTopMenu = Application.CommandBars(iCommandBar)
Set cbpMenuLevel_1 = _
cbTopMenu.Controls.Add(Type:=msoControlPopup, _
Befo=Macro_Name, _
Temporary:=True)
cbpMenuLevel_1.Caption = Caption
cbpMenuLevel_1.Visible = True

Else ' A Menu Item
If Len(Macro_Name) = 0 Then
blnMacro = False
End If
Select Case MenuLevel
Case 2
If blnMacro = False Then
Set cbpMenuLevel_2 = _
cbpMenuLevel_1.Controls.Add(msoControlPopup)
cbpMenuLevel_2.Caption = Caption
If Divider Then cbpMenuLevel_2.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_2.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_1.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 3
If blnMacro = False Then
Set cbpMenuLevel_3 = _
cbpMenuLevel_2.Controls.Add(msoControlPopup)
cbpMenuLevel_3.Caption = Caption
If Divider Then cbpMenuLevel_3.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_3.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_2.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 4
If blnMacro = False Then
Set cbpMenuLevel_4 = _
cbpMenuLevel_3.Controls.Add(msoControlPopup)
cbpMenuLevel_4.Caption = Caption
If Divider Then cbpMenuLevel_4.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_4.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_3.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 5
If blnMacro = False Then
Set cbpMenuLevel_5 = _
cbpMenuLevel_4.Controls.Add(msoControlPopup)
cbpMenuLevel_5.Caption = Caption
If Divider Then cbpMenuLevel_5.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_5.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_4.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
Case 6
If blnMacro = False Then
Set cbpMenuLevel_6 = _
cbpMenuLevel_5.Controls.Add(msoControlPopup)
cbpMenuLevel_6.Caption = Caption
If Divider Then cbpMenuLevel_6.BeginGroup = True
If blnEnabled = False Then _
cbpMenuLevel_6.Enabled = False
Else
Set cbbButton = _
cbpMenuLevel_5.Controls.Add(msoControlButton)
cbbButton.Caption = Caption
cbbButton.OnAction = Macro_Name
If Divider Then cbbButton.BeginGroup = True
If FaceId < "" Then cbbButton.FaceId = FaceId
If blnEnabled = False Then _
cbbButton.Enabled = False
If Len(ShortcutKeyPress) < 0 Then
On Error Resume Next
Application.MacroOptions macro:=Macro_Name, _
Description:=Caption, _
ShortcutKey:=ShortcutKeyPress
On Error GoTo 0
End If
End If
End Select

End If
End If
iRow = iRow + 1
Loop

exit_Sub:
On Error Resume Next
Application.ScreenUpdating = True

' For iLevel = 10 To 1 Step -1
' varLevel = "cbpMenuLevel_" & iLevel
' Set varLevel = Nothing
' Next iLevel
'
' Set cbTopMenu = Nothing
Exit Sub

err_Sub:
Call DeleteMenu
GoTo exit_Sub

End Sub

'/============================/
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes Menus on top CommandBar that are on the template
' worksheet "MenuSheet"
Dim wkstMenuSheet As Worksheet
Dim iRow As Long, iCommandBar As Long