CODEWITHSUNDEEP
excelvbaicons
Waleed
Waleed

Reputation: 919

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

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.

Upvotes: 1

Views: 537

Answers (1)

FaneDuru
FaneDuru

Reputation: 42256

Your requirement can be solved in more ways, but (at least, this is what I know how to handle) using a different approach (CommandBar):

  1. 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...

  1. 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
  1. 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

Upvotes: 2

Related Questions