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