netspeedz
New Member
- Joined
- Aug 11, 2011
- Messages
- 21
I have a user form that displays an image (downloaded using another standard VBA module). Everything works fine on a 32bit installation of Microsoft Office 2021, however, when using the workbook on a system with 64bit installation of Microsoft Office, the images are not being displayed (the download code works fine on 32bit/64bit). Using debug.print statements, I've determined that the issue lies within the code that loads the image (getting image load failures from this code). The user form pops up as designed in both 32bit/64bit - just no image displayed in the 64bit user form image control.
Would appreciate some assistance to find a fix/workaround to get the images displayed on the user form on 64bit Microsoft Office installations. Below, I've included the code for both the source module of the user form and the standard module code for the subroutine that loads the image to the user form.
User Form Module Code below:
Standard Module Code for Subroutine that loads image:
Would appreciate some assistance to find a fix/workaround to get the images displayed on the user form on 64bit Microsoft Office installations. Below, I've included the code for both the source module of the user form and the standard module code for the subroutine that loads the image to the user form.
User Form Module Code below:
VBA Code:
Sub UserForm_Activate()
'ClearCache "http://silverprice.org/charts/silver_3d_b_o_USD.png"
DownloadChart24HourFromWeb
UpdateChart
End Sub
Sub UpdateChart()
'Set Currentchart = Sheets("External Data").ChartObjects(1).Chart
picnm = ThisWorkbook.Path & Application.PathSeparator & "Chart24Hour.png"
'Currentchart.Export Filename:=picnm, FilterName:="PNG"
Image1.Picture = LoadPictureGDI(picnm)
End SubStandard Module Code for Subroutine that loads image:
Code:
Option Explicit
' Declare necessary Windows API functions for GDI+ and OLE
#If VBA7 Then
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 Long) 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 "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#Else
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
#End If
' Declare necessary custom types for GDI+ and OLE
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
' Function to load an image file using GDI+ and return as IPicture
Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As LongPtr
Dim lResult As Long
Dim hGdiImage As LongPtr
Dim hBitmap As LongPtr
' Initialize GDI+
uGdiInput.GdiplusVersion = 1
lResult = GdiplusStartup(hGdiPlus, uGdiInput)
' If GDI+ initialization is successful
If lResult = 0 Then
' Load the image from file
lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)
' If image creation is successful
If lResult = 0 Then
' Convert the GDI+ image to HBITMAP
lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)
' Create IPicture object from HBITMAP
Set LoadPictureGDI = CreateIPicture(hBitmap)
' Release GDI+ image resources
GdipDisposeImage hGdiImage
End If
' Shutdown GDI+
GdiplusShutdown hGdiPlus
End If
End Function
' Function to create IPicture object from HBITMAP
Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture
Dim lResult As Long
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1
' Initialize GUID for 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 PICTDESC structure
With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With
' Create IPicture object from HBITMAP
lResult = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
' Return the IPicture object
Set CreateIPicture = IPic
End Function
I've included the complete working code below for historical purposes as well as helping someone else down the road with similar issues. 
