Is it possible to use PNG images in userforms in 64 bit Excel?

browncoat · Mar 6th 2020

Been scouring for hours and have only come across a few threads discussing converting PNG files so they are compatible in userforms but none of them work, possibly because I'm in 64 bit Excel. This one I've gotten to actually not give errors but it still doesn't work: https://www.excelforum.com/exc…-image-into-userform.html . I converted Long to LongPtr and replaced olepro32.dll with oleaut32.dll which was suggested for 64 bit Excel but still no luck despite no longer getting errors. No images will load.

Wondering if this is a lost cause at this point. Unfortunately it has to be PNG because the API only uses PNG files. All help appreciated.

**KjBox** · Mar 6th 2020

User forms only accept bitmap (.btm) images, however, changing a png file to bitmap before loading it into a user form is possible via VBA using API functions.

Andy Pope provided a solution here

https://www.excelforum.com/exc…-image-into-userform.html

It works on 64 Bit systems

browncoat · Mar 6th 2020

That's the thread I linked to. It does not work for me

**KjBox** · Mar 6th 2020

It works perfectly for me on my 64 Bit system without any modification to the code.

Maybe it has something to do with the actual image. Can you attach the image here and I will try adding it to the userform in the file Andy created.

browncoat · Mar 6th 2020

This is the image. I have a function that automatically downloads from the API to a temp folder on my harddrive:

https://pubchem.ncbi.nlm.nih.g…ompound/cid/135398675/png

**KjBox** · Mar 6th 2020

Thanks for that.

No problem with the image, it loads into the user form perfectly well for me.

I assume the image downloads ok to your temp folder. Does Andy's code work for a different PNG? If you don't have another PNG image then take a screenshot and save it to your temp folder, screenshots should be .png

If that does not work then really difficult for me to imagine what could be going wrong for you.

browncoat · Mar 6th 2020

Yes it downloads fine and other png files do not work. I'm wondering if it has to do with GDPplus. I've also posted a thread here:

https://www.excelforum.com/exc…it-excel.html#post5291205

browncoat · Mar 6th 2020

When you run the example workbook from that thread, do you not get errors from the declared functions? It will not run without me changing those to PtrSafe

mdenino · Mar 6th 2020

Does it work as intended once you add PtrSafe to the declarations?

browncoat · Mar 6th 2020

No I have not gotten it to work. Adding PtrSafe just prevents me from getting errors when it runs. See my very first post about the changes I've made attempting to get it to work. It looks like GdiplusStartup is returning a bad value or no value at all (I don't see any value) as when I run it the part following is skipped:

Code

Public Function LoadImage(ByVal strFName As String) As IPicture
    Dim uGdiInput As GdiplusStartupInput
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long

    uGdiInput.GdiplusVersion = 1
    
    If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then ' this = false so function ends
        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

Display More

**rory** · Mar 6th 2020

You're passing pointers/handles around, so they will need to be LongPtr to work on 64bit Office, not Long.

browncoat · Mar 6th 2020

Quote from rory

You're passing pointers/handles around, so they will need to be LongPtr to work on 64bit Office, not Long.

Hi Rory, thanks for responding. I have done that. As I mentioned in the first post, I replaced all to LongPtr and that resulted in a runtime error 54, file not found: olepro32.dll. A forum online said that for 64 bit I need replace that code and point to oleaut32.dll which I did. That resulted in no longer getting an error but the image still does not load.

**rory** · Mar 6th 2020

I suggest you post the code you have currently for review.

browncoat · Mar 6th 2020

UserForm1

Code

Option Explicit

Private Sub CommandButton1_Click()

    Dim vntFilename As Variant
    
    vntFilename = Application.GetOpenFilename("Images (*.png),*.png")
    If vntFilename = "False" Then Exit Sub
    
    Image1.Picture = LoadImage(vntFilename)

End Sub

Display More

basGDIPlus

Code

Option Explicit
Private Type GUID
    Data1                   As LongPtr
    Data2                   As Integer
    Data3                   As Integer
    Data4(0 To 7)           As Byte
End Type

Private Type PICTDESC
    Size                        As LongPtr
    Type                        As LongPtr
    hPic                        As LongPtr
    hPal                        As LongPtr
End Type

Private Type GdiplusStartupInput
    GdiplusVersion              As LongPtr
    DebugEventCallback          As LongPtr
    SuppressBackgroundThread    As LongPtr
    SuppressExternalCodecs      As LongPtr
End Type

Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, _
    inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As LongPtr
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, _
    hbmReturn As LongPtr, ByVal background As LongPtr) As LongPtr
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, _
    RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr

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

Display More

Module1

Code

Option Explicit

Sub Button1_Click()
    UserForm1.Show
End Sub

**rory** · Mar 6th 2020

OK, you can't just replace every Long with LongPtr. Only pointers and handles need to be LongPtr. I'll have a detailed look when I have time (or failing that I'll just ask Andy when I see him next week :))

browncoat · Mar 6th 2020

Quote from rory

OK, you can't just replace every Long with LongPtr. Only pointers and handles need to be LongPtr. I'll have a detailed look when I have time (or failing that I'll just ask Andy when I see him next week :))

Ah ok hopefully that's the problem. Thanks so much for your help! Crazy (or maybe not?) that you know the author! Small world??

Also, I'd tried it like this. It also doesn't give me errors but it didn't work which is why I tried changing all of them.

Code

Option Explicit
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 PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As Long, _
    inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As Long) As Long
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, _
    hbmReturn As Long, ByVal background As Long) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) 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

Public Function LoadImage(ByVal strFName As String) As IPicture
    Dim uGdiInput As GdiplusStartupInput
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long

    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 Long) 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

Display More

**rory** · Mar 10th 2020

Try this for the GDI Plus module:

Code

Option Explicit
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 LongPtr
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As LongPtr
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, _
    hbmReturn As LongPtr, ByVal background As Long) As LongPtr
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, _
    RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr


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

Display More

browncoat · Mar 11th 2020

YES!!! That works!!!! Thank you so much, you're awesome!!

**rory** · Mar 12th 2020

Glad to help.

Is it possible to use PNG images in userforms in 64 bit Excel?

Participate now!

Share

Users Viewing This Thread