클릭 시 표 도형이 펼쳐지는 효과 일괄 추가하기

참고: 지식인 링크

 

미리보기용 작은 표를 클릭했을 때 자세한 원본 표가 나타나는 기능 같은 것은 파워포인트에 사실 존재하지 않습니다.

애니메이션으로 해당 기능을 구현해야합니다.

가능은 하지만 표나 도형이 여러개일 경우 각각 애니메이션을 추가하는 것은 무척 번거롭습니다.

​

VBA를 이용해서 해당 기능을 자동 구현하도록 만들어 보았습니다.

1. 슬라이드에 3줄이상의 표를 만든 상태여야합니다.

2. 개발도구- 매크로나 Alt-F8을 누르고 AddDetailAnimation을 실행 합니다.

실행화면

그러면 현재 슬라이드의 모든 표 도형을 각각 복사해서

6줄의 표라면 2줄만 남기고 미리보기(preview) 용 표와 미리보기 전용도형(돋보기)을 만들고 이들 도형을 누르면

원래의 6줄짜리 표(detail)가 나타나도록 트리거 애니메이션을 자동으로 추가해줍니다.

 

※표의 이름은 반드시 detail 1 혹은 detail 2 등 detail ~로 시작해야 합니다.(Alt-F10창에서 수정 가능)

실행 결과 화면

즉, 위 그림에서 원래의 6줄짜리 3번 표가 있다면

이 표를 복사해서 미리보기용으로 2줄만 남긴 1번 도형과

돋보기 도형 2번을 생성합니다. 돋보기 도형 대신 다른 Emoji 도형으로 바꿀 수 있습니다.

그리고 1번이나 2번을 눌렀을 때 3번이 아래로 펼쳐지도록 아래로 닦아내기 트리거 애니메이션을 추가해줍니다.

(돋보기를 누르면 닦아내기 효과로 펼치고 2줄짜리 미리보기 표도형을 누르면 계단식 펼침 효과를 보여줍니다.)

​

만일 현재 슬라이드에 추가된 도형과 애니메이션을 삭제하고 원래대로 되돌리려면

RemovePreviewAnimation을 실행해주면 됩니다.

1번, 2번 도형과 트리거 애니메이션을 모두 삭제하고 3번 표도형만 남은 원상태로 돌아갑니다.

​

실제 시연 영상입니다.

 

 

표 내용 펼치기 애니메이션 자동 추가 VBA

​

아래와 같은 코드가 사용되었습니다. 신경을 쓰다보니 코드가 길어졌습니다.

 

'// 표의 2행까지만 복사해서 Preview 도형을 만들고
'// 이 Preview를 눌렀을 때 Detail 표의 전체내용이 아래로 펼쳐지도록 트리거 애니메이션을 추가함
Option Explicit
Sub AddDetailAnimation()
    
    Dim sld As Slide
    Dim shp As Shape, preview As Shape, previewBtn As Shape
    Dim r As Long
    Dim eft As Effect
    
    Set sld = ActiveWindow.View.Slide
    For Each shp In sld.Shapes
    
        If shp.Name Like "detail*" Then
            'detail 도형 복사
            Set preview = shp.Duplicate(1)
            
            preview.Name = "preview" & Mid(shp.Name, 7)
            preview.Left = shp.Left
            preview.Top = shp.Top
            
            '표에서 3번째 줄이상은 삭제
            With preview.Table
                For r = .Rows.Count To 3 Step -1
                    .Rows(r).Delete
                Next r
            End With
            '더보기 버튼 추가
            With preview
                Set previewBtn = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                    .Left + .Width - 25, .Top + .Height - 20, 25, 20)
                previewBtn.Name = "previewBtn" & Mid(shp.Name, 7)
                previewBtn.TextFrame.TextRange = ChrW(55357) & ChrW(56589)
                '말풍선: ChrW(55357) & ChrW(56492), 돋보기:ChrW(55357) & ChrW(56589)
                '아래 손가락:ChrW(55357) & ChrW(56391)
                'Emoji( https://www.fileformat.info/info/emoji/list.htm )
                previewBtn.TextFrame.TextRange.Font.Size = 12
                previewBtn.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
                previewBtn.TextFrame.VerticalAnchor = msoAnchorBottom
                previewBtn.TextFrame.MarginBottom = 0: previewBtn.TextFrame.MarginRight = 0
            End With
            
            'preview 클릭시 detail 도형 나타나는 트리거 애니메이션 추가
            '다른 나타나기 효과 가능(msoAnimEffectWipe, msoAnimEffectStrips...)
            Set eft = sld.TimeLine.InteractiveSequences.Add().AddTriggerEffect( _
                shp, msoAnimEffectStrips, msoAnimTriggerOnShapeClick, preview)
            eft.EffectParameters.Direction = msoAnimDirectionUp
            eft.Timing.Duration = 0.5
            
            'previewBtn 클릭시 detail 도형 나타나는 트리거 애니메이션 추가
            Set eft = sld.TimeLine.InteractiveSequences.Add().AddTriggerEffect( _
                shp, msoAnimEffectWipe, msoAnimTriggerOnShapeClick, previewBtn)
            eft.EffectParameters.Direction = msoAnimDirectionUp
            eft.Timing.Duration = 0.5
            
            'detail 클릭시 자신이 사라지는 애니메이션 추가
            Set eft = sld.TimeLine.InteractiveSequences.Add().AddTriggerEffect( _
                shp, msoAnimEffectWipe, msoAnimTriggerOnShapeClick, shp)
            eft.Timing.Duration = 0.25
            eft.Exit = msoTrue
         End If
         
    Next shp
    
    'Detail 도형들을 위로
    For r = sld.Shapes.Count To 1 Step -1
        If sld.Shapes(r).Name Like "detail*" Then
            sld.Shapes(r).ZOrder (msoBringToFront)
        End If
    Next r
        
End Sub

'// 추가된 미리보기 도형과 트리거 애니메이션 삭제(초기화)
Sub RemovePreviewAnimation()

    Dim sld As Slide
    Dim eft As Effect
    Dim shp As Shape
    Dim i As Long, j As Long

    Set sld = ActiveWindow.Selection.SlideRange(1)
    With sld.TimeLine.MainSequence
        For i = .Count To 1 Step -1
            If .Item(i).Shape.Name Like "detail*" Then
                .Item(i).Delete
            End If
        Next i
    End With
    
    With sld.TimeLine.InteractiveSequences
        For i = .Count To 1 Step -1
            For j = .Item(i).Count To 1 Step -1
                If .Item(i).Item(j).Shape.Name Like "detail*" Then
                    .Item(i).Item(j).Delete
                End If
            Next j
        Next i
    End With
    
    For i = sld.Shapes.Count To 1 Step -1
        If sld.Shapes(i).Name Like "preview*" Then sld.Shapes(i).Delete
    Next i
    
End Sub

 

추가로 유용하게 쓸 수 있는 매크로 코드입니다.

'// 현재 선택한 도형 애니메이션 속성 보기
Private Sub debugAnimInfo()
    
    Dim sld As Slide
    Dim seq As Sequence
    Dim eft As Effect
    Dim shp As Shape
    Set sld = ActiveWindow.Selection.SlideRange(1)
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    With sld.TimeLine
        '일반 애니메이션 시퀀스
        For Each eft In .MainSequence
            If eft.Shape Is shp Then
                Debug.Print "Shape: '"; eft.Shape.Name; "', Type:"; eft.EffectType;
                Debug.Print ", Direction:"; eft.EffectParameters.Direction;
                 
                Debug.Print "Exit: "; IIf(eft.Exit, "True", "False"); " Duration: "; eft.Timing.Duration;
                Debug.Print "Trigger Type: "; eft.Timing.TriggerType
            End If
        Next eft
        
        '트리거 애니메이션 시퀀스
        For Each seq In .InteractiveSequences
            For Each eft In seq
                If eft.Shape Is shp Then
                    Debug.Print "Shape: '"; eft.Shape.Name; "', Type:"; eft.EffectType;
                    Debug.Print ", Direction:"; eft.EffectParameters.Direction;
                    Debug.Print ", Triggered by '" & eft.Timing.TriggerShape.Name; "'"
                    Debug.Print "Exit: "; IIf(eft.Exit, "True", "False"); " Duration: "; eft.Timing.Duration;
                    Debug.Print "Trigger Type: "; eft.Timing.TriggerType
                End If
            Next eft
        Next seq
    End With
    
End Sub

'//선택된 Emoji의 코드 구하기( https://www.fileformat.info/info/emoji/list.htm )
Private Sub getImojiCode()
    Dim str$
    str = ActiveWindow.Selection.TextRange2.Text
    Debug.Print "ChrW("; AscW(Mid(str, 1, 1)) + 65536; ") & ChrW("; AscW(Mid(str, 2, 1)) + 65536; ")"
    
End Sub

샘플 파일을 첨부합니다.

 

클릭시펼쳐지는효과_자동추가2.pptm

0.06MB

 

클릭시펼쳐지는효과_자동추가1.pptm

0.06MB

자동추가2번이 최신 버전이고, 자동추가1번은 돋보기 도형 같은 것을 제외한 단순 버전입니다.

​

질문자님의 슬라이드에 적용하려면,

첨부한 자동추가2번을 매크로 허용해서 열고 질문자님의 표가 있는 슬라이드를 선택한 상태에서

Alt-F8이나 개발도구-매크로를 선택하고

매크로 선택 창이 뜨면 아래에서 매크로 위치로 첨부파일(자동추가2. pptm)을 선택하면

위에 AddDetailAnimation 과 RemovePreviewAnimation 매크로를 실행할 수 있습니다.

생성한 후에는 자동추가2.pptm은 닫아도 됩니다. 생성된 애니메이션은 순수한 파워포인트 애니메이션이라서 pptm으로 저장할 필요 없이 pptx나 ppsx 로 저장하시면 됩니다.