Insert PNG Picture Di Userform VBA Excel

 Aplikasi Excelku. Hallo Sobat Excel semuanya, selamat datang di Blog Aplikasi Excelku. Terimakasih Saya ucapkan kepada Anda semua yang sudah mengunjungi blog sederhana Saya ini. Pada kesempatan ini Saya akan berbagi sebuah tutorial sekaligus tips dan trik mengenai VBA Excel. Dan sesuai dengan judul artikel/postingan ini, Saya akan memberikan tutorial mengenai Cara Menyisipkan (Insert) Gambar PNG Kedalam Userform VBA Excel.

Seperti yang kita ketahui bersama, bahwa di Userform VBA Excel kita hanya bisa menyisipkan (insert) gambar yang berekstensi/format *.jpg, *.jpeg, *.BMP, dan *.ico, untuk format gambar *.PNG pastinya akan secara otomatis ditolak/tidak akan bisa. Ada sebuah cara agar nantinya kita bisa menyisipkan gambar berekstensi/format *.PNG, yaitu dengan menambahkan sebuah kode/script Macro. Dan berikut ini cara atau pun langkah-langkahnya:

Insert PNG Picture Di Userform VBA Excel

Membuat Sebuah Userform Untuk Menyisipkan (Insert) Gambar 

Pada contoh ini saya membuat sebuah Userform yang akan Saya gunakan untuk menyisipkan sebuah file gambar, dimana didalam Userform ini terdapat 2 (dua) komponen control lainnya, diantaranya adalah:

1. Image; dan
2. Command Button.

Dan berikut ini tampilan dari Userformnya:

Menyisipkan Kode/Script Macro

Setelah Userform yang akan digunakan untuk menyisipkan sebuah file gambar sudah ada, selanjutnya adalah menyisipkan kode/script Macro agar nantinya Userform beserta komponen/control lainnya bisa berjalan seperti apa yang kita inginkan. Karena disini Saya menginginkan agar bisa menyisipkan (insert) file gambar berformat PNG kedalam userform tersebut, maka dibutuhkan sebuah scrpt tambahan, dan script tambahan tersebut adalah seperti di bawah ini:

Silahkan Sobat Excel sisipkan kode/script macro di bawah ini kedalam module:

'Insert ke Module

Option Explicit

Private Type GUID

'https://aplikasiexcelku.blogspot.com

    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

'https://aplikasiexcelku.blogspot.com

    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

Selanjutnya Copas kode/script macro di bawah ini kedalam userform:

'Insert ke Userform (CommandButton)

Private Sub CommandButton1_Click()

'https://aplikasiexcelku.blogspot.com

Dim vntFilename As Variant

vntFilename = Application.GetOpenFilename("*.PNG (*.png),*.png")

If vntFilename = "False" Then Exit Sub

Image1.Picture = LoadImage(vntFilename)

End Sub

Jika sudah, silahkan jalankan Userform tersebut, kemudian klik pada tombol Insert Picture (CommandButton1), cari file gambar yang berformat PNG. Dan lihat apa yang terjadi, sekarang kita pun bisa menyisipkan gambar berformat PNG keda dalam Userform VBA Excel.

Demikian artikel Insert PNG Picture Di Userform VBA Excel, mudah-mudahan apa yang sudah Saya sampaikan pada kesempatan kali ini bisa bermanfaat untuk kita semuanya. Sekian, terimakasih, dan Salam Belajar!!!.

Share :