How to create submenus on Shortcut menus

[jycpooh]

Hello,

I have a shortcut right-click menu (developed when I was using Excel
2003) that I have used for a while now. I am now using Excel 2007. I
want to modify the right-click code to include fly-out submenus. I am
not sure how to modify it.

Here is the existing code.

Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)
CommandBars("Cell").Reset
If Intersect(Target, Range("RangePnlL", "RangePnlR")) Is Nothing Then
CommandBars("Cell").Reset
Exit Sub
End If
Call RightClick
End Sub

Sub RightClick()
With CommandBars("Cell")

‘****This group is for air-conditioning equipment
******************
With .Controls.Add(temporary:=True)
.Caption = "A/C Eqpt 3-Phase"
.OnAction = "AC3Phase"
.BeginGroup = True
End With
With .Controls.Add(temporary:=True)
.Caption = "A/C Eqpt 2-Phase"
.OnAction = "AC2Phase"
End With
‘*********************************************************

‘****This group is for Motor equipment ******************
With .Controls.Add(temporary:=True)
.Caption = "Motor 3-Phase"
.OnAction = "Motor3Phase"
.BeginGroup = True
End With
With .Controls.Add(temporary:=True)
.Caption = "Motor 2-Phase"
.OnAction = "Motor2Phase"
End With
With .Controls.Add(temporary:=True)
.Caption = "Motor 1-Phase"
.OnAction = "Motor1Phase"
End With
‘*********************************************************

‘****This group is for miscellaneous loads ******************
With .Controls.Add(temporary:=True)
.Caption = "Misc Loads 2-Phase"
.OnAction = "Misc2Phase"
.BeginGroup = True
End With
With .Controls.Add(temporary:=True)
.Caption = "Misc Loads 1-Phase"
.OnAction = "Misc1Phase"
End With
‘*********************************************************

‘****This group is for transformer loads ******************
With .Controls.Add(temporary:=True)
.Caption = "Xfmr 3-Phase"
.OnAction = "Xfmr3Phase"
.BeginGroup = True
End With
With .Controls.Add(temporary:=True)
.Caption = "Xfmr 2-Phase"
.OnAction = "Xfmr2Phase"
End With
‘*********************************************************

End With
End Sub

Here is what I would like to have:
On mouse right click, I would like to see 4 menu items, that is
Air-Conditioning Equipment
Motor
Misc Equipment
Transformer

If I select Motor, it would expand to give me 3 submenus, namely,
Motor 3-phase, Motor 2-phase and Motor 1-phase. Similarly for Air-
Conditioning Eqpt, Misc Equipment and Transformer.

How do I modify the above code to get the submenus?

Thanks
Jim Chee
Houston, TX

 

[Jim Cone]

For each group button, add a popup control to the menu...
Set cmdEquip = .Controls.Add(msoControlPopup)
Then add the menu items to the popup...
Set cmdItem = cmdEquip.Controls.Add(msoControlButton)

Repeat as necessary.
--
Jim Cone
Portland, Oregon USA




<[email protected]>
wrote in message
Hello,
I have a shortcut right-click menu (developed when I was using Excel
2003) that I have used for a while now. I am now using Excel 2007. I
want to modify the right-click code to include fly-out submenus. I am
not sure how to modify it.
Here is the existing code.

Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)
CommandBars("Cell").Reset
If Intersect(Target, Range("RangePnlL", "RangePnlR")) Is Nothing Then
CommandBars("Cell").Reset
Exit Sub
End If
Call RightClick
End Sub

Sub RightClick()
With CommandBars("Cell")

‘****This group is for air-conditioning equipment
******************
With .Controls.Add(temporary:=True)
.Caption = "A/C Eqpt 3-Phase"
.OnAction = "AC3Phase"
.BeginGroup = True
End With
With .Controls.Add(temporary:=True)
.Caption = "A/C Eqpt 2-Phase"
.OnAction = "AC2Phase"
End With
‘*****************
-snip-
End Sub

Here is what I would like to have:
On mouse right click, I would like to see 4 menu items, that is
Air-Conditioning Equipment
Motor
Misc Equipment
Transformer

If I select Motor, it would expand to give me 3 submenus, namely,
Motor 3-phase, Motor 2-phase and Motor 1-phase. Similarly for Air-
Conditioning Eqpt, Misc Equipment and Transformer.
How do I modify the above code to get the submenus?
Thanks
Jim Chee
Houston, TX