在 VBA 中调整图像大小，保持宽高比

Question

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

这是我写的代码：

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

在 VBA 中调整图像大小，保持宽高比

Resizing image in VBA maintaining aspect ratio

excel

vba

image

aspect-ratio