☰

在 PowerPoint 中复制形状轮廓调整

tag-icon • tag-icon microsoft-powerpoint
在 PowerPoint 中复制形状轮廓调整

PowerPoint 中的某些形状允许使用小黄色手柄更改轮廓：

在此处输入图片描述

有时我会有另一个相同类别的形状（例如另一个六边形），我想赋予其与第一个完全相同的轮廓。有没有办法复制粘贴这些轮廓修改？

答案1

我认为在 PowerPoint 中没有直接的方法可以做到这一点，但几行 VBA 就可以完成这项工作。首先，单击要从中复制调整的形状。然后按住 CTRL 并单击要将调整复制到的形状。然后运行代码：

Sub CopyAdjustments()

    Dim x As Long

    With ActiveWindow.Selection.ShapeRange(1)
        For x = 1 To .Adjustments.Count
            ActiveWindow.Selection.ShapeRange(2).Adjustments(x) = .Adjustments(x)
        Next
    End With

End Sub

如果您需要调整整个演示文稿中分散的大量形状，那么这个会更好。SaveAdjustments 将当前选定形状的调整保存到演示文稿中隐藏的“标签”中。ApplySavedAdjustments 拾取已保存的调整并将其应用于选定形状。这取决于用户的判断... 在拾取/应用调整之前选择一个形状。如果您保存一种形状的调整并将其应用于另一种形状... 好吧，祝你好运。

Sub SaveAdjustments()

    Dim x As Long

    With ActiveWindow.Selection.ShapeRange(1)
        If .Adjustments.Count > 0 Then
            ActivePresentation.Tags.Add "Adjustments", CStr(.Adjustments.Count)
            For x = 1 To .Adjustments.Count
                ActivePresentation.Tags.Add "Adj" & CStr(x), CStr(.Adjustments(x))
            Next
        End If
    End With

End Sub

Sub ApplySavedAdjustments()

    Dim x As Long

    If Len(ActivePresentation.Tags("Adjustments")) > 0 Then
        With ActiveWindow.Selection.ShapeRange(1)
            For x = 1 To CLng(ActivePresentation.Tags("Adjustments"))
                ActiveWindow.Selection.ShapeRange(1).Adjustments(x) = _
                CDbl(ActivePresentation.Tags("Adj" & CStr(x)))
            Next
        End With
    End If
End Sub

相关内容