Menus Create Another Sub Menu

[Jaye7]

I have the following code which adds a Menu based on data in a spreadsheet, can any one help me with an additional code which will add in another POPUP menu level, I want the popup menus to extend from level 3, so there isn't just one popup menu but a popup menu of the popup menu. Sorry if confusing I have tried to explain what I want as simply as I could think of. Basically I want to make the popup menu have it's own popup menu i.e. level 4 is a popup menus of level 3.

Private Sub Workbook_Open()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
On Error GoTo ErrHandler<o:p></o:p>
Application.EnableEvents = True<o:p></o:p>
On Error Resume Next<o:p></o:p>
Application.ActiveWindow.WindowState = xlMaximized<o:p></o:p>
<o:p></o:p>
Dim MenuSheet As Worksheet<o:p></o:p>
Dim MenuObject As CommandBarPopup<o:p></o:p>
<o:p></o:p>
Dim MenuItem As Object<o:p></o:p>
Dim SubMenuItem As CommandBarButton<o:p></o:p>
Dim Row As Integer<o:p></o:p>
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId<o:p></o:p>
<o:p></o:p>
''''''''''''''''''''''''''''''''''''''''''''''''''''<o:p></o:p>
' Location for menu data<o:p></o:p>
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")<o:p></o:p>
''''''''''''''''''''''''''''''''''''''''''''''''''''<o:p></o:p>
<o:p></o:p>
' Make sure the menus aren't duplicated<o:p></o:p>
Call DeleteMenu<o:p></o:p>
<o:p></o:p>
' Initialize the row counter<o:p></o:p>
Row = 2<o:p></o:p>
<o:p></o:p>
' Add the menus, menu items and submenu items using<o:p></o:p>
' data stored on MenuSheet<o:p></o:p>
<o:p></o:p>
Do Until IsEmpty(MenuSheet.Cells(Row, 1))<o:p></o:p>
With MenuSheet<o:p></o:p>
MenuLevel = .Cells(Row, 1)<o:p></o:p>
Caption = .Cells(Row, 2)<o:p></o:p>
PositionOrMacro = .Cells(Row, 3)<o:p></o:p>
Divider = .Cells(Row, 4)<o:p></o:p>
FaceId = .Cells(Row, 5)<o:p></o:p>
NextLevel = .Cells(Row + 1, 1)<o:p></o:p>
End With<o:p></o:p>
<o:p></o:p>
Select Case MenuLevel<o:p></o:p>
Case 1 ' A Menu<o:p></o:p>
' Add the top-level menu to the Worksheet CommandBar<o:p></o:p>
Set MenuObject = Application.CommandBars(1). _<o:p></o:p>
Controls.Add(Type:=msoControlPopup, _<o:p></o:p>
Before:=PositionOrMacro, _<o:p></o:p>
Temporary:=True)<o:p></o:p>
MenuObject.Caption = Caption<o:p></o:p>
<o:p></o:p>
Case 2 ' A Menu Item<o:p></o:p>
If NextLevel = 3 Then<o:p></o:p>
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)<o:p></o:p>
Else<o:p></o:p>
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)<o:p></o:p>
MenuItem.OnAction = PositionOrMacro<o:p></o:p>
End If<o:p></o:p>
MenuItem.Caption = Caption<o:p></o:p>
'If FaceId <> "" Then MenuItem.FaceId = FaceId<o:p></o:p>
If Divider Then MenuItem.BeginGroup = True<o:p></o:p>
<o:p></o:p>
Case 3 ' A SubMenu Item<o:p></o:p>
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)<o:p></o:p>
SubMenuItem.Caption = Caption<o:p></o:p>
SubMenuItem.OnAction = PositionOrMacro<o:p></o:p>
If FaceId <> "" Then SubMenuItem.FaceId = FaceId<o:p></o:p>
If Divider Then SubMenuItem.BeginGroup = True<o:p></o:p>
End Select<o:p></o:p>
Row = Row + 1<o:p></o:p>
<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /><st1:place w:st="on">Loop</st1:place><o:p></o:p>
On Error Resume Next<o:p></o:p>
Application.ScreenUpdating = True<o:p></o:p>
ErrHandler:<o:p></o:p>
<o:p></o:p>
End Sub

thanks

 

[Jaye7]

Can Someone Please Help