2007에서 애니메이션 복사 기능 구현

안타깝지만 2007에서는 애니메이션 복사 기능이 지원이 안됩니다.(관련 링크)

2010이상에서 Alt+Shift+C가 지원됩니다.​

2010이상에서는 VBA에서도 애니메이션 효과 .PickUP 과 .Apply 로 애니메이션을 복사할 수 있지만 2007에서는 방법이 없습니다.

 

다행히 존경하는 Shyam Pillai란 분이 Animation Carbon 이라는 추가기능(Add-in)을 만들긴 했습니다. 

http://skp.mvps.org/ac/index.html

 

실행방법은 먼저 애니메이션이 적용되지 않은 대상 도형(들)을 선택한 후

Animation Carbon 창을 켜고 Clone Animation 탭에서 드롭다운메뉴에서

복사해올 원본 도형을 선택하고 Apply를 누르면 복사됩니다.

 

다만 15일 후에는 등록을 해야하는 유료 추가기능입니다.

 

지식인에 2007에서 애니메이션 복사 기능을 원하셔서  위 제작자가 남긴 코드를 이용해서 특정 도형에 적용된 일반 애니메이션(또는 다수의 애니메이션)을 다른 도형에 일괄로 복사하는 VBA함수를 만들어 테스트해본 것입니다. (실제 2007에서 테스트는 해보지 못함-.-;)

 

1슬라이드의 네모 도형에 2개의 일반 애니메이션이 있을 때

Anim_Copy 로 복사한 다음

다른 2, 3슬라이드에서 다른 도형을 선택하고 Anim_Paste 로 애니메이션을 복사합니다.

(주의: 트리거(시작옵션) 애니메이션은 제외합니다. 2007에서 테스트해보지는 못했습니다-.-;)

​

테스트영상:

 

실제 적용해보려면

아래 첨부파일 매크로 허용해서 열어두고

사용자의 파일을 연 다음

Alt-F8 또는 개발도구-매크로 누르고 창이 뜨면

아래 매크로 위치를 첨부파일(AnimCopy1.pptm)로 선택한 후

Anim_Copy 나 Anim_Paste를 실행합니다.

두 함수를 빠른 실행에 추가해서 Alt+숫자키로 실행할 수도 있겠습니다.

 

AnimCopy1.pptm

0.06MB

 

 

Option Explicit
Const APP_NAME As String = "Copy Animation" '(copy animation function by Shyam Pillai)
Dim efts() As Effect

Sub Anim_Copy()
    
    Dim eft As Effect
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer
    
    'Set sld = ActiveWindow.View.Slide
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    Set sld = shp.Parent
    
    Erase efts
    
    For Each eft In sld.TimeLine.MainSequence
        If eft.Shape Is shp Then
            i = i + 1
            ReDim Preserve efts(1 To i)
            Set efts(i) = eft
        End If
    Next
        
    If i > 0 Then MsgBox "Total (" & i & ") animation effect(s) copied" & vbNewLine & vbNewLine & _
        "from: " & efts(i).Shape.Name _
        & " in Slide " & efts(i).Shape.Parent.SlideIndex, vbInformation, APP_NAME
    
End Sub

Sub Anim_Paste()
    Dim i As Integer
    Dim sld As Slide
    Dim shp As Shape
    Dim oEffect As Effect
    
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    Set sld = shp.Parent
    
    If IsEmpty(efts) Or UBound(efts) = -1 Then
        MsgBox "First, select a source shape and run 'Anim_Copy' to copy any animation effect." _
        & vbNewLine & vbNewLine & _
        "Then, select a target shape and run 'Anim_Paste' to apply the copied animation effects", vbInformation, APP_NAME
        Exit Sub
    End If
    
    If efts(1).Shape Is shp Then MsgBox "The same shape selected. Choose a new target shape.", vbInformation, APP_NAME: Exit Sub
    
    For i = 1 To UBound(efts)
        Set oEffect = efts(i)
        Call TransferEffects(oEffect, sld, shp)
    Next i
    
End Sub

' Below is from https://answers.microsoft.com/en-us/msoffice/forum/all/how-to-copy-paste-animation-effect-in-powerpoint/c0f255c0-167a-4a12-ae37-1e713ee1d8df
' by Shyam Pillai (Microsoft MVP)
Sub TransferEffects(oEffectA As PowerPoint.Effect, _
                    oSlide As Slide, _
                    oShape As PowerPoint.Shape)
    Dim oEffectB As Effect
    Dim IsMotion As Boolean
   
    Set oEffectB = oSlide.TimeLine.MainSequence.AddEffect(oShape, oEffectA.EffectType)
    DoEvents
    On Error Resume Next
    oEffectB.EffectParameters.Amount = oEffectA.EffectParameters.Amount
    If Err.Number = 0 Then
        Select Case oEffectA.EffectParameters.Color2.Type
            Case Is = msoColorTypeScheme
                oEffectB.EffectParameters.Color2.SchemeColor = oEffectA.EffectParameters.Color2.SchemeColor
            Case Is = msoColorTypeRGB
                oEffectB.EffectParameters.Color2.RGB = oEffectA.EffectParameters.Color2.RGB
        End Select
    End If

    oEffectB.EffectParameters.Direction = oEffectA.EffectParameters.Direction
    oEffectB.EffectParameters.FontName = oEffectA.EffectParameters.FontName
   

    If oEffectA.EffectType <> msoAnimEffectGrowShrink Then
        oEffectB.EffectParameters.Size = oEffectA.EffectParameters.Size
    Else
        oEffectB.Behaviors(1).ScaleEffect.ByX = oEffectA.Behaviors(1).ScaleEffect.ByX
        oEffectB.Behaviors(1).ScaleEffect.ByY = oEffectA.Behaviors(1).ScaleEffect.ByY
    End If

    oEffectB.Timing.Duration = oEffectA.Timing.Duration
    oEffectB.Timing.Accelerate = oEffectA.Timing.Accelerate
    oEffectB.Timing.AutoReverse = oEffectA.Timing.AutoReverse
    oEffectB.Timing.Decelerate = oEffectA.Timing.Decelerate
    oEffectB.Timing.Restart = oEffectA.Timing.Restart
    oEffectB.Timing.RewindAtEnd = oEffectA.Timing.RewindAtEnd
    oEffectB.Timing.SmoothStart = oEffectA.Timing.SmoothStart
    oEffectB.Timing.SmoothEnd = oEffectA.Timing.SmoothEnd
    oEffectB.Exit = oEffectA.Exit
    oEffectB.Timing.TriggerType = oEffectA.Timing.TriggerType
    oEffectB.Timing.TriggerDelayTime = oEffectA.Timing.TriggerDelayTime
    oEffectB.Timing.RepeatCount = oEffectA.Timing.RepeatCount
    oEffectB.Timing.RepeatDuration = oEffectA.Timing.RepeatDuration
    oEffectB.Timing.Speed = oEffectA.Timing.Speed

    With oSlide.TimeLine.MainSequence
    If oEffectA.Shape.HasTextFrame Then
        Call .ConvertToAnimateBackground(oEffectB, oEffectA.EffectInformation.AnimateBackground)
    Else
        Call .ConvertToAnimateBackground(oEffectB, True)
    End If

    Select Case oEffectA.EffectInformation.AfterEffect

        Case 2 ' Hide
            Call .ConvertToAfterEffect(oEffectB, oEffectA.EffectInformation.AfterEffect)

        Case 1 ' Dim
            Call .ConvertToAfterEffect(oEffectB, oEffectA.EffectInformation.AfterEffect, oEffectA.EffectInformation.Dim)

        Case 3 ' Hide on click
            Call .ConvertToAfterEffect(oEffectB, oEffectA.EffectInformation.AfterEffect)
    End Select

    Call .ConvertToAnimateInReverse(oEffectB, oEffectA.EffectInformation.AnimateTextInReverse)
    Call .ConvertToTextUnitEffect(oEffectB, oEffectA.EffectInformation.TextUnitEffect)
    End With
   
    Err.Clear
    oEffectB.EffectParameters.Relative = oEffectA.EffectParameters.Relative
    If Err.Number <> 0 Then
        IsMotion = False
    Else
        IsMotion = True
    End If
   
    If IsMotion Then
        oEffectB.Behaviors(1).MotionEffect.Path = oEffectA.Behaviors(1).MotionEffect.Path
        On Error GoTo 0
        If Sgn(Val(oEffectA.Behaviors(1).Timing.Speed)) = -1 Then
            oEffectB.Behaviors(1).MotionEffect.Path = Left(oEffectA.Behaviors(1).MotionEffect.Path, 1) & " " & ReversePathInfo(Trim(Mid(oEffectA.Behaviors(1).MotionEffect.Path, 2)))
        End If
    End If
   
    Exit Sub
errHandler:

    If MsgBox(Err.Number & " " & Err.Description & vbCrLf & "Do you wish to continue?", vbQuestion + vbYesNo, APP_NAME) = vbYes Then
        Resume Next
    End If

End Sub


Function ReversePathInfo(sPath As String) As String
    Dim sItems() As String
    Dim i As Integer
    Dim sPositions() As String
    Dim sReversedPath As String
    Dim sClosedPath As String

    If Not IsNumeric(Right(sPath, 1)) Then
        sClosedPath = Right(sPath, 1)
        sPath = Left(sPath, Len(sPath) - 1)
    End If

    sPath = Replace(sPath, "  ", "~")
    sItems = Split(sPath, "~")
    ReDim sPositions(0 To UBound(sItems))

    For i = LBound(sItems) To UBound(sItems)

        If Left(sItems(i), 1) = "L" Then sPositions(i) = "L"
        If Left(sItems(i), 1) = "C" Then sPositions(i) = "C"
        If Left(sItems(i), 1) = "c" Then sPositions(i) = "c"
        If Left(sItems(i), 1) = "l" Then sPositions(i) = "l"
    Next i

    For i = LBound(sPositions) To UBound(sPositions)

        If LCase(sPositions(i)) = "c" Then
            sPositions(i + 2) = sPositions(i)
            sPositions(i) = ""
            i = i + 2
        End If

    Next i

    For i = UBound(sItems) To LBound(sItems) Step -1

        Select Case Left(sItems(i), 1)

            Case "L", "C", "c", "l"
                sItems(i) = Trim(Mid(sItems(i), 2))
        End Select

        sReversedPath = sReversedPath & sItems(i) & "  " & sPositions(i) & IIf(sPositions(i) <> "", " ", "")
    Next i

    ReversePathInfo = Trim(sReversedPath) & IIf(sClosedPath = "", "", "  " & sClosedPath)
End Function