Programatically set custom icon to added ribbon button

Question

I'm trying to add two icons programmatically to a new ribbon group with VBA. I can add built in icons fine but can't figure out how to use my own files.

TLDR: The code below works if using built in icons with the imageMso attribute but not with custom icons using the image attribute or the getImage callback.

Here is the XML I'm using

<customUI xmlns='http://schemas.microsoft.com/office/2006/01/customui'>
    <ribbon>
        <tabs>
            <tab id='customTab' label='CP Analyzer' insertAfterMso='TabData'>
                <group id='idCPA' label='CP Analyzer'>
                    <button id='customButton1' label='Select Column' size='large' onAction='SelectColumn' image='imgLabel' />
                    <button id='customButton2' label='Run Change Point Analyzer' size='large' onAction='RunCP' image='imgFast' />
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

I have two .png files (called imgLabel.png and imgFast.png) in the same folder as the add-in containing the above code. From using Microsofts Custom UI Editor to verify the syntax it appears image='myImageName' is correct and works when using the UI Editor, but not when used programmatically in VBA.

How can I reference these images?

Here's the full code, it works by modifying the main Excel.officeUI file:

Sub AddR

Dim hFile As Long
Dim path As String, filename As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
filename = "Excel.officeUI"

ribbonXML = ' the XML above

Open path & filename For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

I've tried using the getImage callback described here which works fine for a stand-alone file but not as an Add-In which is the important bit for me here.

Specifically, using the Custom UI editor you can set the call back request in a custom UI XML file that gets embedded into the Excel file. Because I need this as an Add-In though I can't do that, since it's only the code that gets included (at least I can't find a way after searching on this all day). Hence my programatic attempt above to change the main Excel.officeUI file (and change it back to its default when the user disables the Add-In).

Answer 1

I use this method to change images. Step 1: Edit the xml using Custom UI Editor and use getImage:

<customUI xmlns='http://schemas.microsoft.com/office/2006/01/customui'>
    <ribbon>
        <tabs>
            <tab id='customTab' label='CP Analyzer' insertAfterMso='TabData'>
                <group id='idCPA' label='CP Analyzer'>
                    <!-- Change the image for getImage --> 
                    <button id='customButton1' label='Select Column' size='large' onAction='SelectColumn' getImage="getImage" />
                    <button id='customButton2' label='Run Change Point Analyzer' size='large' onAction='RunCP' getImage="getImage" />
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Step 2: Insert a module in VBA called 'MLoadPictureGDI'. Bellow is the code:

'This module provides a LoadPictureGDI function, which can
'be used instead of VBA's LoadPicture, to load a wide variety
'of image types from disk - including png.
'
'The png format is used in Office 2007-2010 to provide images that
'include an alpha channel for each pixel's transparency
'
'Author:    Stephen Bullen
'Date:      31 October, 2006
'Email:     [email protected]

'Updated :  30 December, 2010
'By :       Rob Bovey
'Reason :   Also working now in the 64 bit version of Office 2010


Option Explicit

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


#If VBA7 Then
    'Declare a UDT to store the bitmap information
    Private Type PICTDESC
        Size As Long
        Type As Long
        hPic As LongPtr
        hPal As LongPtr
    End Type
    
    'Declare a UDT to store the GDI+ Startup information
    Private Type GdiplusStartupInput
        GdiplusVersion As Long
        DebugEventCallback As LongPtr
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
    
    'Windows API calls into the GDI+ library
    Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
    Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
    Private Declare PtrSafe Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr)
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#Else
    'Declare a UDT to store the bitmap information
    Private Type PICTDESC
        Size As Long
        Type As Long
        hPic As Long
        hPal As Long
    End Type
    
    'Declare a UDT to store the GDI+ Startup information
    Private Type GdiplusStartupInput
        GdiplusVersion As Long
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
    
    'Windows API calls into the GDI+ library
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
    Private Declare Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As Long)
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

' Procedure:    LoadPictureGDI
' Purpose:      Loads an image using GDI+
' Returns:      The image as an IPicture Object
Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture

    Dim uGdiInput As GdiplusStartupInput
    Dim lResult As Long
#If VBA7 Then
    Dim hGdiPlus As LongPtr
    Dim hGdiImage As LongPtr
    Dim hBitmap As LongPtr
#Else
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long
#End If

    'Initialize GDI+
    uGdiInput.GdiplusVersion = 1
    lResult = GdiplusStartup(hGdiPlus, uGdiInput)

    If lResult = 0 Then

        'Load the image
        lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)

        If lResult = 0 Then

            'Create a bitmap handle from the GDI image
            lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)

            'Create the IPicture object from the bitmap handle
            Set LoadPictureGDI = CreateIPicture(hBitmap)

            'Tidy up
            GdipDisposeImage hGdiImage
        End If

        'Shutdown GDI+
        GdiplusShutdown hGdiPlus
    End If

End Function


' Procedure:    CreateIPicture
' Purpose:      Converts a image handle into an IPicture object.
' Returns:      The IPicture object
#If VBA7 Then
Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture
#Else
Private Function CreateIPicture(ByVal hPic As Long) As IPicture
#End If
    Dim lResult As Long
    Dim uPicInfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim IPic As IPicture

    'OLE Picture types
    Const PICTYPE_BITMAP = 1

    ' Create the Interface GUID (for the IPicture interface)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

    ' Fill uPicInfo with necessary parts.
    With uPicInfo
        .Size = Len(uPicInfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = 0
    End With

    ' Create the Picture object.
    lResult = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

    ' Return the new Picture object.
    Set CreateIPicture = IPic

End Function

Step 3: Implement the callback for getImage in other module:

'Callback for getImage
Sub getImage(control As IRibbonControl, ByRef returnedVal)
    Dim sImg As String
    if control.Id = "customButton1" then
        sImg = "C:\SampleImage1.png" '<--- Change here with your file path
    elseif control.Id = "customButton2" then
        sImg = "C:\SampleImage2.png" '<--- Change here with your file path
    end if
    Set returnedVal = MLoadPictureGDI.LoadPictureGDI(sImg)
End Sub

I didn't test this code, but it will work with small changes