如何调整工作表上的所有图像？

Question

我在工作表上有几个图像.我想将它们全部调整到相同的大小,但我似乎无法让它正常工作.我认为它会像下面的代码,但这实际上使一切都不同.

Sub ChangeAllPics()
Dim s As Shape
For Each s In ActiveSheet.Shapes
s.Select
    s.Width = 500
    s.Height = 200
Next s
End Sub

Answer 1

我想你只是错过了一件小事.默认情况下(当我测试它时)插入到工作表的图像有LockAspectRatio=True.

您需要将其设置为False,否则更改可能是不可预测的:如果您单步执行代码,则F8可以观察到Width更改,但接下来的行将Height恢复之前的宽度更改.

因此,将其设置为false,图像应保留指定的宽度/高度.

Option Explicit
Sub ChangeAllPics()
Dim s As Shape
Dim ws As Worksheet
Set ws = ActiveSheet

For Each s In ActiveSheet.Shapes
    s.LockAspectRatio = msoFalse
    s.Width = 500
    s.Height = 200

Next s
End Sub