使用VBA根据名称在底部对齐所有形状(Powerpoint)

Sub AlignShapesByName()
    Dim sld As Slide
    Dim shp As Shape
    Dim targetName As String
    Dim targetTop As Double
    Dim maxTop As Double
    
    targetName = "TargetShape" '要对齐到底部的形状名称
    
    '遍历所有的幻灯片
    For Each sld In ActivePresentation.Slides
        maxTop = 0 '用于记录最大的顶部位置
        '遍历当前幻灯片的所有形状
        For Each shp In sld.Shapes
            '找到目标形状
            If shp.Name = targetName Then
                '记录目标形状的顶部位置
                targetTop = shp.Top
            End If
            '记录最大的顶部位置
            If shp.Top > maxTop Then
                maxTop = shp.Top
            End If
        Next shp
        '调整所有形状的位置，使它们与目标形状底部对齐
        For Each shp In sld.Shapes
            '排除目标形状本身
            If shp.Name <> targetName Then
                shp.Top = shp.Top + targetTop - maxTop
            End If
        Next shp
    Next sld
    
    MsgBox "所有形状已根据名称在底部对齐。"
End Sub