Adding Items to Shortcut Menus

[MT_Shanachie]

I want to add the Paste Values function to the worksheet shortcut menu (the one that appears when you right click in a cell).

Years ago (in a previous Excel version) I created an auto_open macro which added custom menu items to the shortcut menu. I was using the following syntax:

ShortcutMenus(xlWorksheetCell).MenuItems.Add

The ShortcutMenus object is now hidden and has been replaced with the CommandBars object, and I'm having trouble finding the worksheet shortcut menu. If possible, I would like to add the built-in Paste Values function rather than my custom version.

Can someone point me in the right direction?

Thanks.

[Brian]

Hi,

I was just working with this today!

The first two "menu control" subs work properly. The others are some rough work.

These are called from the open and close events.

Right now, the revised shortcut is available on all sheets, but I only want it available on one sheet, so I am now trying to determine how best to do that. May need to remove it in before right click for every other sheet, but that seems poor.

THE MENU CONTROL SUBS:
Sub CustomiseCellShortcutMenu()
'2002-04-26: Created by Brian West
'From MrExcel Messageboard - Works!
With Application.CommandBars("Cell")
Set temp = .Controls.Add(msoControlButton)
temp.Caption = "Insert Spec Rows"
temp.OnAction = "InsertRowCopyAutoNumCells" '<-- REMEMBER TO UPDATE Sub ClearShortcutMenu()
temp.BeginGroup = True

' Add Next item
'Set temp = .Controls.Add(msoControlButton)
'temp.Caption = "Routine2"
'temp.OnAction = "Routine2" '<-- REMEMBER TO UPDATE Sub ClearShortcutMenu() 'put routine2 in regular module
End With
End Sub

Sub ClearCellShortcutMenu()
' 2002-05-05 Created by Brian West
' Works!

Set SMenu = Application.CommandBars("cell")
NumControls = SMenu.Controls.Count

NumControlsToDelete = 1 '<-- REMEMBER TO UPDATE
NumControlsdeleted = 0

For CurrentControl = NumControls To 1 Step -1
If SMenu.Controls(CurrentControl).Caption = "Insert Spec Rows" _
Or SMenu.Controls(CurrentControl).Caption = "NextRoutineToDelete" Then '<-- REMEMBER TO UPDATE
SMenu.Controls(CurrentControl).Delete
NumControlsdeleted = NumControlsdeleted + 1
End If
Next CurrentControl

If NumControlsdeleted <> NumControlsToDelete Then
MsgBox ("There was a problem removing the items that " _
& Chr(10) & "were added to the cell shortcut menu" _
& Chr(10) & "when this spreadsheet was opened." _
& Chr(10) & Chr(10) & "If the cell shortcut menu is not correct" _
& Chr(10) & "Then contact Brian West.")
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'From Mr.Excel board
On Error GoTo 1
With Application.CommandBars("Cell")
Do
.Controls(1).Delete
Loop
1:
Set temp = .Controls.Add(msoControlButton)
temp.Caption = "Test1"
temp.OnAction = "Routine1" 'put routine1 in regular module
Set temp = .Controls.Add(msoControlButton)
temp.Caption = "Test2"
temp.OnAction = "Routine2" 'put routine2 in regular module
End With
End Sub


Sub ShortCutMenu()
'Displays a shortcut menu when the sub is run
'From VBE help "Adding and displaying shortcut menus"
Set x = CommandBars.Add("Custom", msoBarPopup)
Set y = x.Controls.Add
With y
.FaceId = 26
.Caption = "Analyze the data"
End With
Set z = x.Controls.Add
With z
.FaceId = 17
.Caption = "Graph the data"
End With
x.ShowPopup 200, 200
End Sub

Sub ChangeExistingMenu()
'VBE Help: Add Method (CommandBars Collection)
'VBE Help: CommandBarPopup Object
'commandbars.Add( ..?!
End Sub

Sub ShowMenuBarNames()
Dim mnu As MenuBar
For Each mnu In Application.MenuBars
MsgBox mnu.Caption 'shows blank except for worksheet and chart
Next
End Sub
Sub ShowCommandBarNames()
Dim mnu As CommandBar
i = 1
For Each mnu In Application.CommandBars
'MsgBox mnu.Name '
ActiveSheet.Select
Range("A" & i) = mnu.Name
i = i + 1
Next
End Sub
Sub ShowShortcutNames()
'Dim mnu As MenuItems
i = 2
ActiveSheet.Select
For Each mnu In Application.ShortcutMenus(ActiveSheet.Range(B1)).MenuItems

'MsgBox mnu.Name '

Range("b" & i) = mnu.Name
i = i + 1
Next
End Sub
Sub AddCustom()
'From http://support.microsoft.com/default...;en-us;Q158434
'works! but how to add macro to run?!
Application.ShortcutMenus(xlWorksheetCell).MenuItems.Add _
Caption:="C1"
End Sub

Sub AddCustomC2()
'From http://support.microsoft.com/default...;en-us;Q158434
'works! but how to add macro to run?!
Application.ShortcutMenus(xlWorksheetCell).MenuItems.Add _
Caption:="C1"
End Sub
Sub Shortcutmessage()
MsgBox ("C1 Test")
End Sub
Sub SetControl()

'From OnAction Property
'From Adding and managing menu bars and menu items
'If you want to delete the same menu item, you would use the following code:
Sub DelCustom()
Application.ShortcutMenus(xlWorksheetCell).MenuItems("C1").Delete
End Sub

' This example adds a command bar control to the command bar named "Custom" and sets the macro named "MySub" to run whenever the button is clicked.

Set myBar = .CommandBars("Custom")
Set myControl = myBar.Controls _
.Add(Type:=msoControlButton)
With myControl
.FaceId = 2
.OnAction = "MySub"
End With
myBar.Visible = True
End Sub

Sub ShowCommandBarPopupNames()
Dim mnu As CommandBar
For Each mnu In Application.CommandBars(Type:=msoControlPopup)
MsgBox mnu.Caption 'shows blank except for worksheet and chart
Next
End Sub

Sub FromHelp1()
Set x = CommandBars.Add("Custom", msoBarPopup)
Set y = x.Controls.Add
With y
.FaceId = 26
.Caption = "Analyze the data"
End With
Set z = x.Controls.Add
With z
.FaceId = 17
.Caption = "Graph the data"
End With
x.ShowPopup 200, 200
End Sub


SUBS CALLED FROM:
Private Sub Workbook_Open()
'2002-05-03: Created by Brian West
CustomiseCellShortcutMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
' 2002-05-05: Addedby Brian West
MsgBox ("before close")
Call ClearCellShortcutMenu
End Sub


OTHER:::::
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
'From Excel Help
'NOT CORRECT - Adds the item the first time, but then it stays - need another action to remove it.!
'This example adds a new menu item to the shortcut menu for cells B1:B10.
For Each icbc In Application.CommandBars("cell").Controls
If icbc.Tag = "brccm" Then icbc.Delete
Next icbc
If Not Application.Intersect(Target, Range("b1:b10")) _
Is Nothing Then
With Application.CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=6, _
temporary:=True)
.Caption = "New Context Menu Item"

.OnAction = "MyMacro"
.Tag = "brccm"
End With
End If
End Sub

[MT_Shanachie]

Thanks, Brian. That got me going down the path I needed.