Dear Hennie

Thanks for the feedback. Your query was something very interesting to work
with..

If this post helps click Yes
---------------
Jacob Skaria


"Hennie Neuhoff" wrote:

Jacob, Thank you very much, it works perfectly!. By the way - I posed the
question to the author (John Weilbach) who said its not worth the trouble!
--
HJN


"Jacob Skaria" wrote:

I have revised the code and added more comments. CreateMenu is a separate
procedure which can be called from code like below. Two arguments to be
passed are the menu name and the worksheet in which you have the
details...The main menu will be created just before the help menu. The macro
name is to be in the 5th column of the worksheet.


CreateMenu "MyNewMenu",Activeworkbook.Sheets("Sheet1")



Sub CreateMenu(strMainMenu As String, wsMenu As Worksheet)

'Procedure to create an Excel Menu and multiple levels of sub menus
'-------------------Arguments-----------------------------
'strMainMenu - The Main menu caption to be passed
'wsMenu - Worksheet in which menu details are stored(5 fields)
'Unique MenuID, Caption, Menu type,Parent Menu ID, Macro

Dim lngRow As Long 'Start Row
Dim intMenuID As Integer 'Unique menu ID
Dim intMenuPID As Integer 'Parent menu ID
Dim intHelpMenu As Integer 'Help menu index
Dim varMenuType As Variant 'Menu type (1,10)
Dim strMacroName As String 'Macro to be assigned
Dim strMenuCaption As String 'Menu captions
Dim cbMainMenuBar As CommandBar 'Command Bar
Dim arrCBC() As CommandBarControl 'Command Bar control Array

lngRow = 2
ReDim arrCBC(0)
'Remove if the menu already exists
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete
On Error GoTo 0
'Identify menu location just before Help menu
Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
intHelpMenu = cbMainMenuBar.Controls("Help").Index
'Create main menu
Set arrCBC(0) = cbMainMenuBar.Controls.Add(Type:=10, Befo=intHelpMenu)
arrCBC(0).Caption = strMainMenu

'Create sub menus
Do While wsMenu.Range("A" & lngRow) < ""
intMenuID = wsMenu.Range("A" & lngRow)
ReDim Preserve arrCBC(intMenuID)
strMenuCaption = wsMenu.Range("B" & lngRow)
varMenuType = wsMenu.Range("C" & lngRow)
intMenuPID = wsMenu.Range("D" & lngRow)
strMacroName = wsMenu.Range("E" & lngRow)

Set arrCBC(intMenuID) = arrCBC(intMenuPID).Controls.Add(Type:=varMenuType)
arrCBC(intMenuID).Caption = strMenuCaption
If intMenuPID 0 Then
arrCBC(intMenuID).OnAction = strMacroName
End If

lngRow = lngRow + 1
Loop

End Sub


If this post helps click Yes
---------------
Jacob Skaria


"Hennie Neuhoff" wrote:

I use excel 2003
Tkank you much appreciated!
--
HJN


"Jacob Skaria" wrote:

Will definitely look into. Please let us know which version of Excel you are
using.

If this post helps click Yes
---------------
Jacob Skaria


"Hennie Neuhoff" wrote:

I copied the code from the article you suggested, however Case 4
gives an error - Method or data member not found (Error 461) in the line
SubMenuItem.Controls.Add(Type:=msoControlButton)

Any suggestions ?


This is the code for Case 4:
Case 4 ' A SubSubMenu Item
Set SubSubMenuItem =
SubMenuItem.Controls.Add(Type:=msoControlButton)
SubSubMenuItem.Caption = Caption
SubSubMenuItem.OnAction = PositionOrMacro
If FaceId < "" Then SubSubMenuItem.FaceId = FaceId
If Divider Then SubSubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop

--
HJN