调整VBA中的图像大小保持纵横比 [英] Resizing image in VBA maintaining aspect ratio

问题描述

我有一个VBA宏，用于存储文件中的图像并将其粘贴到Excel电子表格中，位于名为Country Profile的工作表中。
我想调整图像大小以使其宽度为350px，同时保持其宽高比。

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.

这是我写的代码：

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?

推荐答案

试试这样：

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

这篇关于调整VBA中的图像大小保持纵横比的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！