Using PNG images on a UserForm

[AD_Taylor]

This is probably a question that has been asked many times before but I can't find an answer that works at the moment.

I need to be able to load a PNG image onto my User Form. Through research I've found that LoadPicture can't load PNGs and that using a downloaded function LoadPictureGDI would work. I'm sure this downloaded code would work on any 32 bit system but unfortunately I'm using a 64 bit system

Is there any workaround that I can use to load PNGs easily onto a User Form?

The downloaded code is below as well. If anybody can make it PtrSafe so that I can use it with a 64 bit system, you would genuinely be a lifesaver!

Thanks in advance,
AD

'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 to provide images that
'include an alpha channel for each pixel's transparency
'
'Author:    Stephen Bullen
'Date:      31 October, 2006
'Email:     stephen@oaltd.co.uk


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


'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 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




' 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 hGdiPlus As Long
    Dim lResult As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long


    '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
Private Function CreateIPicture(ByVal hPic As Long) As IPicture


    Dim lResult As Long, uPicInfo As PICTDESC, IID_IDispatch As GUID, 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

 

[swaps]

hmm .. nver thought so.. will have to investigate on this.. ll come back with ans soon buddy..

 

[Norie]

Are you using 64-bit Office?

 

[Norie]

If you download the example workbooks from here you'll find the updated LoadPictureGDI.

 

[swaps]

Are you using 64-bit Office?

nope its 32-bit system..

 

[Norie]

swaps

That question was for the OP really.

 

[AD_Taylor]

Hi Norie,

Yes I am using 64 bit Office as far as I know.

And it has to be said that you are a lifesaver!! Code works perfectly, loading the PNGs whenever I need them.
You wouldn't believe how long I spent searching for this - definitely saving a copy for future use.

Thanks again!!
AD

 

[pbornemeier]

Updated link to the file mentioned in Post #4: Images on Custom Ribbon controls in Excel 2007-2013

The updated MLoadPictureGDI module is in Toggle Button 2.xlsm

 

[Farlo]

Updated link to the file mentioned in Post #4: Images on Custom Ribbon controls in Excel 2007-2013

The updated MLoadPictureGDI module is in Toggle Button 2.xlsm

I'm sorry to be reviving a dead post, but I recently upgraded from Office 2010 x64 to Office 2013 x64 and now the LoadPictureGDI function doesn't seem to work (the image box just stays blank). I have no idea how the code is doing what it does and the link pbornemeier provided claims to work in Office 2013, so I'm guessing it's a problem with just the 64-bit version of 2013. Does anyone know how one might get this working or should I just use 32-bit Office? Thanks, and sorry again about being a necromancer.