Copiando ajustes de contorno de forma no powerpoint

Question

Algumas formas no PowerPoint permitem alterar o contorno usando pequenas alças amarelas:

Às vezes eu tenho outra forma da mesma cateogria (por exemplo, outro hexágono) que quero dar o mesmo contorno exato do primeiro. Existe uma maneira de copiar e colar essas modificações de contorno?

    

Answer 1

Eu não acho que haja alguma maneira direta de fazer isso no PowerPoint, mas algumas linhas de VBA farão o trabalho. Primeiro, clique na forma da qual você deseja copiar os ajustes FROM. Então segure CTRL e clique na forma que você deseja copiar os ajustes para. Em seguida, execute o código:

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

Se houver muitas formas espalhadas pela apresentação que você precise ajustar, isso será melhor. SaveAdjustments salva os ajustes da forma atualmente selecionada para "tags" ocultas na apresentação. ApplySavedAdjustments pega os ajustes salvos e os aplica à forma selecionada. É deixado para o usuário ser sensível ... selecione uma forma antes de pegar / aplicar ajustes. E se você salvar ajustes para um tipo de forma e aplicá-los a um tipo diferente ... bem, melhor sorte.

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