VBA 将 2 个相同的图像调整为相同的大小（宽度和高度）

Question

步骤 1) 打开 Excel，将“Whosebug 的徽标复制到 sheet：https://blog.whosebug.com/wp-content/uploads/Whosebug-logo-300.png

步骤 2) 复制并粘贴该徽标两次

步骤 3) 手动将其中一个徽标调整为一些荒谬的大小：http://i.imgur.com/87lIB8o.png

现在如何通过 vba 将那个讨厌的徽标调整为与原始徽标相同的大小

我尝试了以下宏（是的，我尝试使用 With / End With）：

Sub sds()
    ActiveSheet.Shapes.Range(Array("Picture 2")).Width = ActiveSheet.Shapes.Range(Array("Picture 1")).Width
    ActiveSheet.Shapes.Range(Array("Picture 2")).Height = ActiveSheet.Shapes.Range(Array("Picture 1")).Height
End Sub

它串起来，最后看起来像：http://i.imgur.com/e7BKq9y.png

Answer 1

对于包含图像的形状，默认设置了属性 .LockAspectRatio = msoTrue。这会导致您描述的行为。

为避免这种情况，您可以将其切换为 msoFalse，然后更改 .Height 和 .Width，然后再次将其切换为 msoTrue：

Sub picture_size()
   ActiveSheet.Shapes.Range(Array("Picture 2")).LockAspectRatio = msoFalse

   ActiveSheet.Shapes.Range(Array("Picture 2")).Width = ActiveSheet.Shapes.Range(Array("Picture 1")).Width
   ActiveSheet.Shapes.Range(Array("Picture 2")).Height = ActiveSheet.Shapes.Range(Array("Picture 1")).Height

   ActiveSheet.Shapes.Range(Array("Picture 2")).LockAspectRatio = msoTrue
End Sub

但如果目标只是恢复原来的大小，那么：

Sub picture_100Percent()
   ActiveSheet.Shapes.Range(Array("Picture 2")).ScaleHeight 1, msoTrue
End Sub

VBA 将 2 个相同的图像调整为相同的大小（宽度和高度）

VBA Resizing 2 Identical Images to the same size (width and height)

vba

excel

excel-2010

excel-2007