I did it using GDI+ and having the images in a separate folder, but disappointed that there doesn't seem a way for VBA to reference images within the construct of the file.
In a module:
#If VBA7 Then
' 64-bit declaration using LongPtr
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
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 Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As Long
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 'note oleault21
#Else
' 32-bit declaration using Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
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 Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 'note olepro32
#End If
Public Function LoadImage(ByVal strFName As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As LongPtr
Dim hGdiImage As LongPtr
Dim hBitmap As LongPtr
uGdiInput.GdiplusVersion = 1
If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If
End Function
Public Function ConvertToIPicture(ByVal hPic As LongPtr) As IPicture
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1
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
With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With
OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set ConvertToIPicture = IPic
End Function
Usage
Sub GetButtonImage(control As IRibbonControl, ByRef returnedVal)
If a = b Then
Set returnedVal = LoadImage("C:\myimages\MyImage.jpg")
Else
returnedVal = "AnimationOnclick"
End If
End Sub
Useful info here too
Bookmarks