Search code examples
excelvbaicons

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.


Solution

  • 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