Powerpoint VBA 将所有选定对象调整为最大对象的宏

Question

背景

我添加了一个执行以下操作的加载项：对于所有选定的 powerpoint 对象（例如 4 个矩形），加载项将调整所有对象的高度和宽度以匹配选择中最大对象的高度和宽度。

我尝试编写一个 VBA 宏来复制此加载项，但没有任何反应（调整在以下问题中找到的代码：Powerpoint VBA Macro to copy object's size and location and paste to another object）：

Sub test()
    Dim w As Double
    Dim h As Double
    Dim obj As Shape

    w = 0
    h = 0

    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width > w Then
            w = obj.Width
        Else
            obj.Width = w
        End If

        If obj.Height > h Then
            h = obj.Height
        Else
            obj.Height = h
        End If
    Next
End Sub

问题

知道如何使此代码有效吗？

Answer 1

经过更多的研究，这是一个有效的代码（不确定它是否真的有效，因为我是 VBA 的新手）：

Sub resizeAll()
    Dim w As Double
    Dim h As Double
    Dim obj As Shape

    w = 0
    h = 0

    ' Loop through all objects selected to assign the biggest width and height to w and h
    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width > w Then
            w = obj.Width
        End If

        If obj.Height > h Then
            h = obj.Height
        End If
    Next

    ' Loop through all objects selected to resize them if their height or width is smaller than h/w
    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width < w Then
            obj.Width = w
        End If

        If obj.Height < h Then
            obj.Height = h
        End If
    Next
End Sub

Powerpoint VBA 将所有选定对象调整为最大对象的宏

Powerpoint VBA Macro to resize all objects selected to the biggest object

powerpoint

vba