PPT VBA - 使选定的对象与第一个对象的大小相同

Question

我试图使所有选定的对象/形状与 PPT VBA 上第一个选定的对象的大小相同。尝试了以下代码但不起作用。

子调整形状大小() Dim NumShapes 作为整数 Dim Shp 作为变体

NumShapes = ActiveWindow.Selection.Count
If NumShapes < 1 Then
    MsgBox "Please select at least one shape."
    Exit Sub
End If

Get dimensions of the first selected shape
Set Shp = ActiveWindow.Selection.ShapeRange(1)
With Shp
    BaseShpHeight = .Height
    BaseShpWidth = .Width
End With

For i = 2 To NumShapes
    Set Shp = ActiveWindow.Selection.ShapeRange(i)

        With Shp
            .Height = BaseShpHeight
            .Width = BaseShpWidth
        End With
Next i
    
    Else
        MsgBox "Error"
    End If

结束子

Answer 1

对于初学者，始终选择“调试”|在尝试运行代码之前编译 VBA 项目。在编译没有错误之前，尝试运行代码是没有意义的。因为它不会运行。

此外，始终声明所有变量。 将 Option Explicit 放在每个模块的顶部，让 VBA 强制您执行此操作。

并适当地声明变量。对于形状变量，将其声明为Shape而不是variant； VBA 的智能感知将帮助您以这种方式处理形状属性/方法。一般来说，计数器和指数应声明为 Long。

这是一个固定版本，添加了注释来解释我所做的更改的原因。

Sub ResizeShape()

Dim NumShapes As Long   ' not Integer
Dim Shp As Shape        ' not Variant
' Declare the other variables you've used
Dim BaseShpHeight As Single
Dim BaseShpWidth As Single
Dim i As Long

' NumShapes = ActiveWindow.Selection.Count
NumShapes = ActiveWindow.Selection.ShapeRange.Count

If NumShapes < 1 Then
    MsgBox "Please select at least one shape."
    Exit Sub
End If

' The next line was supposed to be a comment
' I've marked it as such
' Get dimensions of the first selected shape

Set Shp = ActiveWindow.Selection.ShapeRange(1)

With Shp
    BaseShpHeight = .Height
    BaseShpWidth = .Width
End With

For i = 2 To NumShapes
    Set Shp = ActiveWindow.Selection.ShapeRange(i)

        With Shp
            .Height = BaseShpHeight
            .Width = BaseShpWidth
        End With
Next i
    
' There's no IF statement that corresponds to this
' Commenting it out
'    Else
'        MsgBox "Error"
'    End If
End Sub