PPT VBA实现：将选中对象统一设为首个选中对象的尺寸

你的代码无法运行主要存在语法和结构错误，以下是问题分析及修正后的完整代码：

问题点梳理 #

• 未注释的文本：Get dimensions of the first selected shape这行没有添加注释符号'，会被VBA当作代码执行，直接触发编译错误。
• 多余分支结构：代码末尾的Else和End If没有对应的If语句，破坏了代码的逻辑结构。
• 变量未声明：BaseShpHeight、BaseShpWidth和循环变量i都未提前声明，虽VBA允许隐式声明，但易引发意外问题。

修正后的代码 #

Sub ResizeShape()
    Dim NumShapes As Integer
    Dim Shp As Variant
    Dim BaseShpHeight As Single
    Dim BaseShpWidth As Single
    Dim i As Integer
    
    NumShapes = ActiveWindow.Selection.Count
    If NumShapes < 1 Then
        MsgBox "请至少选中一个形状。"
        Exit Sub
    End If
    
    ' 获取第一个选中形状的尺寸
    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
End Sub

关键修改说明 #

• 给所有变量添加显式声明，指定对应数据类型（Single用于存储尺寸数值，Integer用于计数）。
• 给说明文本添加注释符号'，避免编译错误。
• 删除多余的Else和End If语句，修复代码逻辑结构。
• 将提示文本改为中文，适配中文使用场景（如需英文可改回原句）。

内容的提问来源于stack exchange，提问作者Stacia Lin