VBA: Is it possible to copy a complete shortcut menu?

[Brian]

Is it possible to copy a complete shortcut menu? Or do I need to recreate each item one at a time?

Thanks,

Brian

[brettvba]

are you wanting to copy a custom menu?

[Brian]

What I really want is to add a line to the cell right-click shortcut menu but only have it active on for a certain range of cells on one particular sheet in one workbook.

I can create a completely custom menu and this works fine, but I would like all of the normal selections to appear as well. It tried to simply set a control on the new one equal to a control on the old one, but that did not work (or I could not find the correct syntax). I could recreate each item individually, but that is a lot of items.

This simplest would be to duplicate the normal shortcut menue and then add my one line but I have not succeded.

The problem with changing the built-in menu, is how to change it back to the original if someone clicks on another sheet or workbook. I started looking at this but it got messy and did not get too far.

There is probably something simple that I am missing.

I have tried:
Sub CreatePopUp() ' creates the custom popup menu
Dim NewCB As CommandBar
Dim NewCB2 As CommandBar

Set NewCB = CommandBars.Add(PopUpCommandBarName, msoBarPopup, False, True)
With NewCB.Controls.Add(Type:=msoControlButton)
.Caption = "Insert Spec Rows"
.OnAction = "InsertRowCopyAutoNumCells" '<-- REMEMBER TO UPDATE Sub ClearShortcutMenu()
.BeginGroup = True
End With

'FAILED - invalid procedure call or argument Set NewCB2 = Application.CommandBars("PopUpCommandBarName")
'FAILEd " Set NewCB2 = CommandBars("PopUpCommandBarName")
Set SMenu = Application.CommandBars("cell")
NumControls = SMenu.Controls.Count

'NumControlsAdded = 0

For CurrentControl = 1 To NumControls Step 1 '<<<-FAILED!

'FAILED Object does not support property or method: NewCB.Controls.Add(Type:=msoControlButton) = SMenu.Controls(CurrentControl)
'FAILED NewCB2.Controls.Add = SMenu.Controls(CurrentControl)
'NewCB.Controls(CurrentControl) = SMenu.Controls(CurrentControl)
'Object does not support property or method.
Next CurrentControl

'For CurrentControl = 1 To NumControls Step 1 '<<<-FAILED!
'
' With NewCB.Controls.Add(Type:=msoControlButton)
' .OnAction = "XX" 'SMenu.Controls(CurrentControl).OnAction.Value '"MyMacroName"
' .FaceId = SMenu.Controls(CurrentControl).FaceId '71
' .Caption = SMenu.Controls(CurrentControl).Caption ' "Custom Menu 1"
' .TooltipText = SMenu.Controls(CurrentControl).TooltipText '"Custom Tooltip Text 1"
' .BeginGroup = SMenu.Controls(CurrentControl).BeginGroup
' End With
'Next CurrentControl

With NewCB.Controls.Add(Type:=msoControlButton)
.Caption = "Insert Spec Rows"
.OnAction = "InsertRowCopyAutoNumCells" '<-- REMEMBER TO UPDATE Sub ClearShortcutMenu()
.BeginGroup = True
End With

Set NewCB = Nothing
End Sub