在VBA中调整图像大小保持纵横比

Question

我有一个 VBA 宏，用于获取文件中的图像并将其粘贴到 Excel 电子表格中名为“国家概况”的工作表中。我想调整图像大小，使其宽度为 350px，同时保持其纵横比。

这是我写的代码：

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

该代码有效并且图像被插入到所需的文件中。但是，不保持纵横比。我可以做什么来纠正这个问题？

Answer 1

试试这样：

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