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

I have code that adds images from a selected folder to cells. Everything works, but not always - on two out of four computers it works, but on the other two it doesn't. What's going on with the non-working computer:

When trying to rotate the image by 90?, it does not reload the rotated image into userform.image (it displays as if it were an empty shape) Additionally, is there a way to perform this operation without losing image quality, because later when I display the image in a Windows program by clicking on it in the cell, it is enlarged and the quality of the image is greatly reduced (hardly visible).

There are two questions: How can I do this so that the image quality is better when displayed, and why doesn't this code work on all computers? sample file attached.

Maybe 'cause IE was removed from the computers …

dareksg, I've arranged for you to rotate the image on each computer (at least I hope so ) using a different method than copying the chart. But keep in mind that the rotation occurs only in the UserForm, into the sheet the image is inserted in its original form.

Consider whether the clicked image needs to be opened in an external program. Since you're storing images in the workbook, maybe zooming the image can also happen in the workbook. When you open an image in an external program, especially small images can be distorted because that program can zoom in to fill the entire screen (or at least a large part of it). Then the original pixels are enlarged, which ends up blurring the image. And you are unlikely to be able to control the scale of this zooming.
If you choose to enlarge the image in the sheet, then you can control the magnification size yourself. For example, you click on the image and it zooms in 2 or 3 times (depending on what magnification scale you choose). Another click on that image (enlarged) should return it to a small size.

Attention. The code is adapted to the 32-bit version of MS Office. For the 64-bit version, the winAPI function declarations must be adjusted accordingly.

Artik

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