Add an icon to (custom right_click menu) , Application.ShortcutMenus - excel

Question

I am using this code to add an entry to excel right_click menu:
Private Sub Workbook_Open()
Application.ShortcutMenus(xlWorksheetCell).MenuItems.Add "Open document", "OpenDocument", , 1, , ""
End Sub
Sub OpenDocument()
‘vba code here
End Sub
I need to add an icon to this entry (using shell32.dl or any standalone image), as it is now blank.

Answer 1

Your requirement can be solved in more ways, but (at least, this is what I know how to handle) using a different approach (CommandBar):
To place a custom picture, please try the first version. It uses a picture from a specific path:
Sub AddItemContextMenuWithImage_1()
Const butName As String = "Open document"
Const calledProc As String = "testSubX"
deleteCellCustomControl butName
Dim cmBar As CommandBar, ctrlButt As CommandBarButton, picPicture As IPictureDisp
Set cmBar = Application.CommandBars("Cell")
Set ctrlButt = cmBar.Controls.Add(Type:=msoControlButton, Before:=1) 'create it to be the first menu option
Set picPicture = stdole.StdFunctions.LoadPicture(ThisWorkbook.Path & "\test.gif") 'accepted extensions: bmp, jpg, gif
With ctrlButt
.Picture = picPicture
.OnAction = calledProc
.Caption = butName
End With
End Sub
To check it, the demonstative Sub should look as:
Sub testSubX()
MsgBox "It works..."
End Sub
Of course, you may adapt the code to call your own/necessary Sub...
A second version uses/copies a picture already added on a specific sheet of ThisWorkbook:
Sub AddItemContextMenuWithImage_2()
Const butName As String = "Open document"
Const calledProc As String = "testSubX"
deleteCellCustomControl butName
Dim cmBar As CommandBar, ctrlButt As CommandBarButton
Set cmBar = Application.CommandBars("Cell")
Set ctrlButt = cmBar.Controls.Add(Type:=msoControlButton, Before:=1) 'create it to be the first menu option
ActiveSheet.Pictures("Picture 2").Copy 'need to have a "Picture 2" picture on the active sheet
'you can copy it as image of the newly added control button
With ctrlButt
.PasteFace 'paste the above copied picture
.OnAction = calledProc
.Caption = butName
End With
End Sub
The third version uses standard, already defined FaceIDs. There are so many, that it is very probable to find something suitable for your need, so this is the version I prefer:
Sub AddItemContextMenuWithImage_3()
'Here the list of FaceID controls with their images:
'https://bettersolutions.com/vba/ribbon/face-ids-2003.htm
Const butName As String = "Open document"
Const calledProc As String = "testSubX"
deleteCellCustomControl butName
Dim cmBar As CommandBar, ctrlButt As CommandBarButton
Set cmBar = Application.CommandBars("Cell")
Set ctrlButt = cmBar.Controls.Add(Type:=msoControlButton, Before:=1) 'create it to be the first menu option
With ctrlButt
.FaceId = 1661
.OnAction = calledProc
.Caption = butName
End With
End Sub
A lot of such FaceIDs can be found here. I also place the link as a comment inside the Sub, to remain there for people being interested in this approach...
All the above Subs firstly call the next Sub, to preliminarily delete the menu option, if it already exists:
Sub deleteCellCustomControl(strBut As String)
On Error Resume Next 'for the case of not existing button to be deleted...
Application.ShortcutMenus(xlWorksheetCell).MenuItems(strBut).Delete
On Error GoTo 0
End Sub
If there is only such a custom option in the context menu, or if you want deleting all of them (the custom once), you can simple reset the command Bar, using:
Private Sub ResetContextMenuBar()
Application.CommandBars("Cell").Reset
End Sub