Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 69
Default Creating submenus


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?


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Creating submenus

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?




  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 69
Default Creating submenus

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?





  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Creating submenus

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?







  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 69
Default Creating submenus

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?










  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Creating submenus

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?










  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 69
Default Creating submenus

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?











  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Creating submenus

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?













Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Creating Id shail Excel Worksheet Functions 8 September 14th 06 06:30 PM
keep submenus open? GoBobbyGo Excel Discussion (Misc queries) 1 April 7th 06 08:31 PM
How can one add submenus in Excel 2003? Herwig Excel Discussion (Misc queries) 2 December 2nd 04 07:08 PM
Creating add-ins jomni[_2_] Excel Programming 2 April 1st 04 04:01 AM
Color of Menus and subMenus Soniy Excel Programming 1 September 16th 03 09:47 AM


All times are GMT +1. The time now is 01:30 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"