Sub BuildMenu()
' 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
If NextLevel = 4 Then
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlPopup)
Else
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.OnAction = PositionOrMacro
End If
SubMenuItem.Caption = Caption
If FaceId < "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
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
End Sub
I would so it recursively though, then you can add extra levels without
changing the code. I'll see what I can do for you shortly.
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Alan M" wrote in message
...
HI Bob
Hope you can work this out
' 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
The data used is shown he
Level Caption Position/Macro
1 &Showroom Activity 10
2 &Setup ViewSetup
2 Sales &Data
3 Sales &1 Data ViewSales1_Data
3 Sales &2 Data ViewSales2_Data
3 Sales &3 Data ViewSales3_Data
3 Sales &4 Data ViewSales4_Data
3 Sales &5 Data ViewSales5_Data
3 Sales &6 Data ViewSales6_Data
3 Sales &7 Data ViewSales7_Data
3 Sales &8 Data ViewSales8_Data
2 &Dealer Summary View_Dept
2 &Weekly Summary View_Weekly
2 Weekly &Report View_Report
2 &Analysis Reports
3 &Department ViewAnalysis_Dept
3 Sales&1 ViewAnalysis_Sales1
3 Sales&2 ViewAnalysis_Sales2
3 Sales&3 ViewAnalysis_Sales3
3 Sales&4 ViewAnalysis_Sales4
3 Sales&5 ViewAnalysis_Sales5
3 Sales&6 ViewAnalysis_Sales6
3 Sales&7 ViewAnalysis_Sales7
3 Sales&8 ViewAnalysis_Sales8
2 &Trend Graphs
3 Graph &Department ViewGraph_Dept
3 Graph Sales&1 ViewGraph_Sales1
3 Graph Sales&2 ViewGraph_Sales2
3 Graph Sales&3 ViewGraph_Sales3
3 Graph Sales&4 ViewGraph_Sales4
3 Graph Sales&5 ViewGraph_Sales5
3 Graph Sales&6 ViewGraph_Sales6
3 Graph Sales&7 ViewGraph_Sales7
3 Graph Sales&8 ViewGraph_Sales8
2 Print Menu
3 Print &Weekly Report PrintReport
3 Print &Analysis Reports
4 &Department PrintAnalysis_Dept
4 Sales&1 PrintAnalysis_Sales1
4 Sales&2 PrintAnalysis_Sales2
4 Sales&3 PrintAnalysis_Sales3
4 Sales&4 PrintAnalysis_Sales4
4 Sales&5 PrintAnalysis_Sales5
4 Sales&6 PrintAnalysis_Sales6
4 Sales&7 PrintAnalysis_Sales7
4 Sales&8 PrintAnalysis_Sales8
3 Print &Trend Graphs
4 &Department PrintGraph_Dept
4 Sales&1 PrintGraph_Sales1
4 Sales&2 PrintGraph_Sales2
4 Sales&3 PrintGraph_Sales3
4 Sales&4 PrintGraph_Sales4
4 Sales&5 PrintGraph_Sales5
4 Sales&6 PrintGraph_Sales6
4 Sales&7 PrintGraph_Sales7
4 Sales&8 PrintGraph_Sales8
"Bob Phillips" wrote:
Post the code and example data.
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Alan M" wrote in message
...
Yes this code also operates from a level driven table.
The levels currently are from 1-3 inclusive. I have added level 4
entries
to
the column and need to amend the Select Case code to account for this
and
generate the correct actions. ANy ideas pleae.....sorry to be a
nuisance...I
have only today to get this done!!!
"Bob Phillips" wrote:
Alan,
I have a table driven menu builder myself, and basically it will
mean an
amount of re-work. You will need to add a column to show that this
row
is
subordinate to the previous row, and show when it reverts back. I
have a
level number, and then use recursive code to build it.
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Alan M" wrote in message
...
Hi Bob,
Many thanks for your post...however, the code I am using is linked
to
a
sheet in with the menu is built up from the contents of the cells.
There
are
58 rows in the sheet! To use your code would mean starting from
scratch.
Can
you advise how to add a third level of menu i.e a sub submenu
using
the
Select Case code I have shown on my previous post.
"Bob Phillips" wrote:
Option Explicit
'If you put code in the appropriate workbook open event, and
'delete it in the close it will exist only for that workbook.
'Here is an example of a building a commandbar on the fly
'when you open a workbook. It adds a sub-menu to the Tools menu.
Private Sub Workbook_Open()
Dim oCb As CommandBar
Dim oCtl As CommandBarPopup
Dim oCtlBtn As CommandBarButton
On Error Resume Next
Set oCb = Application.CommandBars("Worksheet Menu Bar")
oCb.Controls("myButton").Delete
On Error GoTo 0
Set oCb = Application.CommandBars("Worksheet Menu Bar")
With oCb
Set oCtl = .Controls.Add( _
Type:=msoControlPopup, _
temporary:=True)
oCtl.Caption = "myButton"
With oCtl
With .Controls.Add(Type:=msoControlPopup)
.Caption = "mySubMenu"
With .Controls.Add(Type:=msoControlButton)
.Caption = "mySubMacroButton1"
.FaceId = 161
.OnAction = "mySubMacro1"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "mySubMacroButton2"
.FaceId = 161
.OnAction = "mySubMacro2"
End With
End With
Set oCtlBtn = .Controls.Add(Type:=msoControlButton)
oCtlBtn.Caption = "myMacroButton2"
oCtlBtn.FaceId = 161
oCtlBtn.OnAction = "myMacro2"
End With
'etc.
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim oCb As CommandBar
Set oCb = Application.CommandBars("Worksheet Menu Bar")
oCb.Controls("Tools").Controls("myButton").Delete
End Sub
'To add this, go to the VB IDE (ALT-F11 from Excel), and in
'the explorer pane, select your workbook. Then select the
'ThisWorkbook object (it's in Microsoft Excel Objects which
'might need expanding). Double-click the ThisWorkbook and
'a code window will open up. Copy this code into there,
'changing the caption and action to suit.
'This is part of the workbook, and will only exist with the
'workbook, but will be available to anyone who opens the
'workbook.
--
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.
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?