Loading an image into Userform.Image and loss of image quality

Thank you Artik, for the neat proposal with the clipboard. Although adapting it to 64-bit scared me, it seems like I managed to adjust the code to the 64-bit version, and it works. As for the pictures, they have to be displayed like that, but I won't reduce their size too much, so as not to lose quality.

Below I am sending the code that works for me on 32 and 64.

Dzięki

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As LongPtr
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As LongPtr
    Private Declare PtrSafe Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As LongPtr, ByVal lpszFile As String) As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef PicDesc As uPicDesc, ByRef RefIID As Any, ByVal fOwn As LongPtr, ByRef IPic As IPicture) As LongPtr
#Else
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef PicDesc As uPicDesc, ByRef RefIID As Any, ByVal fOwn As Long, ByRef IPic As IPicture) As Long
#End If

'Requires a reference to the "OLE Automation" type library

'----------------------------------------------------------------------------
' User-Defined Type for API Calls
'----------------------------------------------------------------------------

'Declare a Type 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 Type to store the bitmap information
Private Type uPicDesc
    Size            As Long
    Type            As Long
    hPic            As LongPtr
    hPal            As LongPtr
End Type

Function PastePicture() As IPicture

    Const lMETAFILE As Long = 14

    Dim lPictureAvailable As LongPtr
    Dim lClipHandle As LongPtr
    Dim lPicHandle  As LongPtr
    Dim lCopyHandle As LongPtr
    Dim uInterGUID  As GUID
    Dim uPictureInfo As uPicDesc
    Dim lOLEHandle  As LongPtr
    Dim iTempPicture As IPicture

    'Check if the clipboard contains a picture file
    lPictureAvailable = IsClipboardFormatAvailable(lMETAFILE)

    If lPictureAvailable <> 0 Then

        'Get a Handle on the Clipboard
        lClipHandle = OpenClipboard(0&)

        If lClipHandle > 0 Then

            'Get a Handle on the Picture
            lPicHandle = GetClipboardData(lMETAFILE)
            'Make a local copy, in case the clipboard is changed
            lCopyHandle = CopyEnhMetaFile(lPicHandle, vbNullString)

            'Release Handle from Clipboard
            lClipHandle = CloseClipboard

            'Only Continue if we have a handle on the Picture
            If lPicHandle <> 0 Then

                ' Create the Interface GUID (for the IPicture interface)
                With uInterGUID
                    .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 UPictureInfo with necessary parts.
                With uPictureInfo
                    .Size = Len(uPictureInfo)   ' Length of structure.
                    .Type = 4                   ' Type of Picture = Metafile
                    .hPic = lCopyHandle         ' Handle to image.
                    .hPal = 0                   ' Handle to palette.
                End With

                'Create the IPicture Object
                lOLEHandle = OleCreatePictureIndirect(uPictureInfo, uInterGUID, True, iTempPicture)

                If lOLEHandle = 0 Then
                    Set PastePicture = iTempPicture
                End If
            End If
        End If
    End If
End Function