Resizing image in VBA maintaining aspect ratio

Question

I have a VBA macro that goes for an image in a file and sticks it into an Excel spreadsheet, in a worksheet called "Country Profile". I would like to resize the image so that it has a width of 350px, while maintaining its aspect ratio.

This is the code that I wrote:

Public Sub Macro15()

Dim picname As String
Dim shp As Shape
Dim present As String

Sheets("Country Profile").Activate
Sheets("Country Profile").Select
ActiveSheet.Pictures.Delete

Cells(19, 40).Select 'This is where picture will be inserted (column)

picname = Sheets("REPORT ON").Range("A2").Value 'This is the picture name

Cells(19, 46).Select

            Call ActiveSheet.Shapes.AddPicture("C:\Users\" & Environ("UserName") & "\Maps with Cities\" & picname & ".png", _
            LockAspectRatio = msoTrue, msoCTrue, Left:=Cells(19, 40).Left, Top:=Cells(19, 46).Top, Width:=350, Height:=-1).Select

End Sub

The code works and the image is inserted in the desired file. However, the aspect ratio is not maintained. What can I do to correct this?

Answer 1

Try it like this:

With ActiveSheet.Pictures.Insert(PicPath)
    .ShapeRange.LockAspectRatio = msoTrue
    .Width = 350
End With