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