Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating Submenus
Hi I am using this example code to create a menu in my workbook.
Sub CreateMenu() ' This sub should be executed when the workbook is opened. ' NOTE: There is no error handling in this subroutine Dim MenuSheet As Worksheet Dim MenuObject As CommandBarPopup Dim MenuItem As Object Dim SubMenuItem As CommandBarButton Dim Row As Integer Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId '''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Location for menu data Set MenuSheet = ThisWorkbook.Sheets("MenuSheet") '''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Make sure the menus aren't duplicated Call DeleteMenu ' Initialize the row counter Row = 2 ' Add the menus, menu items and submenu items using ' data stored on MenuSheet Do Until IsEmpty(MenuSheet.Cells(Row, 1)) With MenuSheet MenuLevel = .Cells(Row, 1) Caption = .Cells(Row, 2) PositionOrMacro = .Cells(Row, 3) Divider = .Cells(Row, 4) FaceId = .Cells(Row, 5) NextLevel = .Cells(Row + 1, 1) End With Select Case MenuLevel Case 1 ' A Menu ' Add the top-level menu to the Worksheet CommandBar Set MenuObject = Application.CommandBars(1). _ Controls.Add(Type:=msoControlPopup, _ Befo=PositionOrMacro, _ Temporary:=True) MenuObject.Caption = Caption Case 2 ' A Menu Item If NextLevel = 3 Then Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup) Else Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton) MenuItem.OnAction = PositionOrMacro End If MenuItem.Caption = Caption If FaceId < "" Then MenuItem.FaceId = FaceId If Divider Then MenuItem.BeginGroup = True Case 3 ' A SubMenu Item Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton) SubMenuItem.Caption = Caption SubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubMenuItem.FaceId = FaceId If Divider Then SubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop End Sub I would like to amend it so that submenu levels appear. ie. Wizards- Wizard1 Wizard2 Wizard3- Subwizard1 Subwizard2 etc Can anyone provide a clue for this please? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating Submenus
See other post.
-- HTH Bob Phillips (remove nothere from email address if mailing direct) "Alan M" wrote in message ... Hi I am using this example code to create a menu in my workbook. Sub CreateMenu() ' This sub should be executed when the workbook is opened. ' NOTE: There is no error handling in this subroutine Dim MenuSheet As Worksheet Dim MenuObject As CommandBarPopup Dim MenuItem As Object Dim SubMenuItem As CommandBarButton Dim Row As Integer Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId '''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Location for menu data Set MenuSheet = ThisWorkbook.Sheets("MenuSheet") '''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Make sure the menus aren't duplicated Call DeleteMenu ' Initialize the row counter Row = 2 ' Add the menus, menu items and submenu items using ' data stored on MenuSheet Do Until IsEmpty(MenuSheet.Cells(Row, 1)) With MenuSheet MenuLevel = .Cells(Row, 1) Caption = .Cells(Row, 2) PositionOrMacro = .Cells(Row, 3) Divider = .Cells(Row, 4) FaceId = .Cells(Row, 5) NextLevel = .Cells(Row + 1, 1) End With Select Case MenuLevel Case 1 ' A Menu ' Add the top-level menu to the Worksheet CommandBar Set MenuObject = Application.CommandBars(1). _ Controls.Add(Type:=msoControlPopup, _ Befo=PositionOrMacro, _ Temporary:=True) MenuObject.Caption = Caption Case 2 ' A Menu Item If NextLevel = 3 Then Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup) Else Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton) MenuItem.OnAction = PositionOrMacro End If MenuItem.Caption = Caption If FaceId < "" Then MenuItem.FaceId = FaceId If Divider Then MenuItem.BeginGroup = True Case 3 ' A SubMenu Item Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton) SubMenuItem.Caption = Caption SubMenuItem.OnAction = PositionOrMacro If FaceId < "" Then SubMenuItem.FaceId = FaceId If Divider Then SubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop End Sub I would like to amend it so that submenu levels appear. ie. Wizards- Wizard1 Wizard2 Wizard3- Subwizard1 Subwizard2 etc Can anyone provide a clue for this please? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
keep submenus open? | Excel Discussion (Misc queries) | |||
Creating submenus | Excel Programming | |||
Creating a Log | Excel Programming | |||
How can one add submenus in Excel 2003? | Excel Discussion (Misc queries) | |||
Color of Menus and subMenus | Excel Programming |