Adding an image to a range with original dimension

Question

I'm trying to insert an image at a specific range, I want that image to be inserted with its original dimensions.

The following code works fine, but the image is resized:

Sub InsertPictureInRangeAntes(path As String, PictureFileName As String, TargetCells As Range)
'inserts a picture and resizes it to fit the TargetCells range
Dim p As Shape, t As Double, l As Double, w As Double, h As Double
    If dir(path, vbDirectory) = "" Then
        MsgBox "Doesn't exists an image in this path", vbInformation
        Exit Sub
    Else:
        path = path & PictureFileName
    End If
    'import picture
    Set p = ActiveSheet.Shapes.AddPicture(Filename:=path, linktofile:=msoFalse, _
        savewithdocument:=msoCTrue, Left:=l, Top:=t, Width:=w, Height:=h)
    'determine positions
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    'position picture
    With p
        .Top = t
        .Left = l
        .Width = w'I dont know how to take the original dimensions
        .Height = h
    End With
    Set p = Nothing
End Sub

Any question post on comments!

Answer 1

Instead of AddPicture use Pictures.Insert

Sub addPicture()

    Dim pct

    Set pct = Worksheets("Sheet1").Pictures.Insert("H:\My Documents\My Pictures\abc.jpg")

    '/ Set Top,Left etc if required.
    pct.Top = 1
    pct.Left = 10

End Sub