Menus Create Another Sub Menu

Jaye7

Well-known Member
Joined
Jul 7, 2010
Messages
1,060
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.

Rich (BB code):
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
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Watch MrExcel Video

Forum statistics

Threads
1,123,288
Messages
5,600,743
Members
414,404
Latest member
OKELKEV

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top