ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   New Users to Excel (https://www.excelbanter.com/new-users-excel/)
-   -   How to add a submenu to a submenu? (https://www.excelbanter.com/new-users-excel/112558-how-add-submenu-submenu.html)

tan

How to add a submenu to a submenu?
 
Hi all,

I have already wrote a vba routine for custom menu. It reads the level of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m trying
to add a submenu to a submenu and not sure the walkaround. Can someone throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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

Bob Phillips

How to add a submenu to a submenu?
 
The code already handles a third level.

All you need to do is to add another row in the worksheet immediately below
its parent with a level of 3. On the parent (level 2 item) make sure that
there is no faceid otherwise the code will fail.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi all,

I have already wrote a vba routine for custom menu. It reads the level of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My

MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m

trying
to add a submenu to a submenu and not sure the walkaround. Can someone

throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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




tan

How to add a submenu to a submenu?
 
Hi Phillips,

I needs the code to handle a fourth level. Submenu is my third level.


Rgds,

"Bob Phillips" wrote:

The code already handles a third level.

All you need to do is to add another row in the worksheet immediately below
its parent with a level of 3. On the parent (level 2 item) make sure that
there is no faceid otherwise the code will fail.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi all,

I have already wrote a vba routine for custom menu. It reads the level of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My

MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m

trying
to add a submenu to a submenu and not sure the walkaround. Can someone

throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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





Bob Phillips

How to add a submenu to a submenu?
 
Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As Object
Dim SubSubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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)
If FaceId < "" Then MenuItem.FaceId = FaceId
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
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)
If FaceId < "" Then SubMenuItem.FaceId = FaceId
SubMenuItem.OnAction = PositionOrMacro
End If
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
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

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi Phillips,

I needs the code to handle a fourth level. Submenu is my third level.


Rgds,

"Bob Phillips" wrote:

The code already handles a third level.

All you need to do is to add another row in the worksheet immediately

below
its parent with a level of 3. On the parent (level 2 item) make sure

that
there is no faceid otherwise the code will fail.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi all,

I have already wrote a vba routine for custom menu. It reads the level

of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My

MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m

trying
to add a submenu to a submenu and not sure the walkaround. Can someone

throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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







Andy Wiggins

How to add a submenu to a submenu?
 
This page might help:
http://www.bygsoftware.com/Excel/Int...menu_maker.htm

The Excel download file is he
http://www.bygsoftware.com/examples/...gMenuMaker.zip

It can create menus to over 200 levels.

--
Andy Wiggins FCCA
www.BygSoftware.com
Excel, Access and VBA Consultancy
-

"Tan" wrote in message
...
Hi all,

I have already wrote a vba routine for custom menu. It reads the level of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My
MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m
trying
to add a submenu to a submenu and not sure the walkaround. Can someone
throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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




tan

How to add a submenu to a submenu?
 
Hi Phillips,

Thanks for helping me. I greatly appreciate. Can we exchange any sharing in
future between us? My email is from Singapore. Whats
your email?


Best Regards,
Tan


"Bob Phillips" wrote:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As Object
Dim SubSubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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)
If FaceId < "" Then MenuItem.FaceId = FaceId
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
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)
If FaceId < "" Then SubMenuItem.FaceId = FaceId
SubMenuItem.OnAction = PositionOrMacro
End If
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
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

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi Phillips,

I needs the code to handle a fourth level. Submenu is my third level.


Rgds,

"Bob Phillips" wrote:

The code already handles a third level.

All you need to do is to add another row in the worksheet immediately

below
its parent with a level of 3. On the parent (level 2 item) make sure

that
there is no faceid otherwise the code will fail.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi all,

I have already wrote a vba routine for custom menu. It reads the level

of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My
MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m
trying
to add a submenu to a submenu and not sure the walkaround. Can someone
throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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







Bob Phillips

How to add a submenu to a submenu?
 
I frequent the newsgroups regularly, that is where I answer questions, so
that all may share in the responses.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi Phillips,

Thanks for helping me. I greatly appreciate. Can we exchange any sharing

in
future between us? My email is from Singapore. Whats
your email?


Best Regards,
Tan


"Bob Phillips" wrote:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As Object
Dim SubSubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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)
If FaceId < "" Then MenuItem.FaceId = FaceId
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
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)
If FaceId < "" Then SubMenuItem.FaceId = FaceId
SubMenuItem.OnAction = PositionOrMacro
End If
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
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

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi Phillips,

I needs the code to handle a fourth level. Submenu is my third level.


Rgds,

"Bob Phillips" wrote:

The code already handles a third level.

All you need to do is to add another row in the worksheet

immediately
below
its parent with a level of 3. On the parent (level 2 item) make sure

that
there is no faceid otherwise the code will fail.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Tan" wrote in message
...
Hi all,

I have already wrote a vba routine for custom menu. It reads the

level
of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My
MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I

m
trying
to add a submenu to a submenu and not sure the walkaround. Can

someone
throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem 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










All times are GMT +1. The time now is 08:24 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com