Question

步骤1）打开Excel，复制＆＃34; stackoverflow的徽标到表格中：http://blog.stackoverflow.com/wp-content/uploads/stackoverflow-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个相同图像调整为相同尺寸（宽度和高度）

1 个答案: