Help with modifying VBA Macro - Works fine but needs fine tuning !

Below is VBA Macro Code that uploads images from Desktop Folder onto Worksheet. The code is Functional ie it works fine, but need some modification.

Sub InsertPic()
    Dim path As String, pic As String, pname As String
    Dim lastrow As Long, r    As Range
    Dim bExists               As Boolean

    path = "C:\Users\user\Desktop\NewArrivals\images"    'change as req
    lastrow = Range("A" & Rows.Count).End(xlUp).Row

    For Each r In Range("A2:A" & lastrow)
        bExists = False
        pic = r.Value
        pname = path & pic & ".jpg"
        ' check existence of file as jpg
        If Dir(pname) = vbNullString Then
            ' check existence of file as png
            pname = path & pic & ".png"
            If Dir(pname) <> vbNullString Then bExists = True
        Else
            bExists = True
        End If
        
        If bExists Then
            Rows(r.Row).RowHeight = 150
            With ActiveSheet.Pictures.Insert(pname)
                With .ShapeRange
                    .LockAspectRatio = msoTrue
                    .Height = 100
                    .Width = 100
                End With
                .Left = Columns("E").Left + Columns("E").Width / 2 - .Width / 2
                .Top = Rows(r.Row).Top + Rows(r.Row).Height / 2 - .Height / 2
            End With
            r.Offset(0, 2).Value = pic
        Else
            Cells(r.Row, "E") = "**** File Not Found *****"
        End If
    Next
End Sub

The code seems to ALTER the size of image during upload, which I DON'T want it to.

I have already created standard, uniform size of all images.

I simply want the code to pick the image & place it on Worksheet, without re-sizing it.

The Image size is 210 px X 150 px. - the code should also adjust size of Row Height & Col Width accordingly.

Anyone care to modify the code to remove that aspect of it's functionality ?

Thanks in Advance.