타이머 회전 애니메이션 만들기

위와 같은 휴대폰의 타이머 애니메이션을 파워포인트에서 만들려고 하면
사라지기 나 강조효과에서 마땅한 애니메이션이 없습니다.

 

그래서 돌아가는 원을 조각내어서 1초마다 각 조각이 사라지게 해보았습니다.

BlockArc 를 그리고 조절점을 360/60 간격으로 조절해야합니다.

그리고 60부터 숫자를 표시하고 1초후 사라지게 해야 합니다.

​

단순 반복이고 정밀한 각도 조절이 필요하므로 이 과정을 VBA로 자동화시켜보았습니다.

​

​첨부파일1의 슬라이드 1: BlockArc를 이용한 애니메이션 (Auto1 매크로)

첨부파일 1의 슬라이드2: 작은 원을 그려서 애니에미션 효과 적용(Auto2매크로)

​

원의 테두리 선이나 작은 원이 나타났다가 사라지도록 했습니다.​

실행 영상

 

 

첨부파일 2의 5,6 슬라이드에서는 가운데 시간이 나타났다가 다시 사라지는 애니메이션이 번거로워서

숫자가 담긴 흰색 원도형이 계속 사라지도록 바꿔보았습니다.

8,9 슬라이드에서는 0.5초 간격으로 사라지도록 변경해보았습니다.

 

 

자동화 코드는 아래와 같습니다.

기본이 Imax= 60, iStep=1 으로 1초에 하나씩 60개의 조각원이 사라집니다. 이 값을 변경할 수 있습니다.

각각 120과 2로 바꾸면 60초동안 120개의 조각원이 1/2초동안씩 사라지면서 애니메이션이 더욱 세밀해집니다.

각각 240과 4이면 60초동안 240개의 조각원이 1/4초동안씩 더욱 더 세밀해집니다.

Const PI = 3.14159265358979
Const Margin As Single = 150        '원의 바깥 여백
Const M As Single = 1               '작은 원의 바깥 여백
Const iMax = 60                    '작은 원 개수
Const iStep = 1                     '없어지는 단계

'// Imax= 60, iStep=1/ 120,2/ 240, 4

Sub Auto1()
    
    drawBlockArc
        
    addAnimation
    
End Sub

Sub Auto2()

    drawCircles
    
    addAnimation
    
End Sub

Function drawBlockArc()
    
    Dim Pres As Presentation
    Dim sld As Slide
    Dim Shp0 As Shape, Shp1 As Shape
    Dim l!, t!, w!, rb!, SH!, SW!
    'Dim iMax As Integer
    Dim i As Integer

    Set Pres = ActivePresentation
    Set sld = ActiveWindow.Selection.SlideRange(1)
    
    With Pres.PageSetup: SH = .SlideHeight: SW = .SlideWidth: End With
    rb = SH / 2 - Margin '큰 원의 반지름
    
    '배경 큰 원
    l = SW / 2 - rb
    t = Margin
    w = rb * 2
    For i = 1 To iMax / iStep
        With sld.Shapes.AddShape(msoShapeOval, l, t, w, w)
            .Name = "BigOval" & i
            .Fill.ForeColor.RGB = rgbWhite
            With .TextFrame.TextRange
                .Text = i
                .Font.Name = "Calibri"
                .Font.Color.RGB = rgbSteelBlue
                .Font.Size = 20
            End With
        End With
    Next i
    
    
    For i = 1 To iMax
        
        Set Shp1 = sld.Shapes.AddShape(msoShapeBlockArc, l, t, w, w)
        Shp1.Name = "Oval" & i
        Shp1.Fill.ForeColor.RGB = rgbSteelBlue
        Shp1.Line.Visible = msoFalse
        Shp1.Adjustments(1) = (360 / iMax) * (i - 1) - 90
        Shp1.Adjustments(2) = (360 / iMax) * (i) - 90
        Shp1.Adjustments(3) = 0.02
     
    Next i

End Function

Function drawCircles()
    
    Dim Pres As Presentation
    Dim sld As Slide
    Dim Shp0 As Shape, Shp1 As Shape, Shp2 As Shape
    Dim l!, t!, w!, rb!, rs!, SH!, SW!
    'Dim iMax As Integer
    Dim i As Integer
    Dim arrShp() As String

    Set Pres = ActivePresentation
    Set sld = ActiveWindow.Selection.SlideRange(1)
    
    'iMax = 60  '// 작은 원 개수
    ReDim arrShp(iMax / 2)
    With Pres.PageSetup: SH = .SlideHeight: SW = .SlideWidth: End With
    rb = SH / 2 - Margin '큰 원의 반지름
    
    '배경 큰 원
    l = SW / 2 - rb
    t = Margin
    w = rb * 2
    For i = 1 To iMax / iStep
        With sld.Shapes.AddShape(msoShapeOval, l, t, w, w)
            .Name = "BigOval" & i
            .Fill.ForeColor.RGB = rgbWhite
            With .TextFrame.TextRange
                .Text = i
                .Font.Name = "Calibri"
                .Font.Color.RGB = rgbSteelBlue
                .Font.Size = 20
            End With
        End With
    Next i
    
    '12시방향 작은 원
    rs = Tan((360 / (iMax * 2)) * (PI / 180)) * rb '작은 원의 반지름
    l = SW / 2 - rs
    t = SH / 2 - rb - rs
    w = rs * 2
    Set Shp1 = sld.Shapes.AddShape(msoShapeOval, l + M, t + M, w - M * 2, w - M * 2)
    Shp1.Name = "Oval" & iMax
    Shp1.Fill.ForeColor.RGB = rgbSteelBlue
    Shp1.Line.Visible = msoFalse
    
    '6시방향 작은 원
    l = SW / 2 - rs
    t = SH / 2 + rb - rs
    w = rs * 2
    Set Shp2 = sld.Shapes.AddShape(msoShapeOval, l + M, t + M, w - M * 2, w - M * 2)
    Shp2.Name = "Oval" & iMax / 2
    Shp2.Fill.ForeColor.RGB = rgbSteelBlue
    Shp2.Line.Visible = msoFalse
    
    sld.Shapes.Range(Array(Shp1.Name, Shp2.Name)).Group.Name = "OvalSet0"
    arrShp(0) = "OvalSet0"
    '12시와 6시 작은원을 그룹으로 만들어 복사 후 회전
    For i = 1 To Int(iMax / 2) - 1
        
        With sld.Shapes("OvalSet0")
            l = .Left
            t = .Top
            With .Duplicate(1)
                .Left = l
                .Top = t
                .Rotation = 360 / iMax * (i)
                .Name = "OvalSet" & i
                .GroupItems(1).Name = "Oval" & i
                .GroupItems(2).Name = "Oval" & (iMax / 2) + i
                arrShp(i) = .Name
            End With
        End With
        
    Next i
    
    sld.Shapes.Range(arrShp).Ungroup
    
    '정렬
    For i = i To iMax
        sld.Shapes("Oval" & i).ZOrder msoSendToFront
    Next i
    
End Function

'// not used
Function drawCount()
    Dim sld As Slide
    Dim Shp0 As Shape, Shp1 As Shape
    Dim l!, t!
    Dim i As Integer
    
    Set sld = ActiveWindow.View.Slide
    
    For i = 1 To iMax
        
        With sld.Shapes("BigOval0")
            l = .Left
            t = .Top
            With .Duplicate(1)
                .Left = l
                .Top = t
                .Name = "BigOval" & i
                With .TextFrame.TextRange
                    .Text = i
                    .Font.Name = "Calibri"
                    .Font.Color.RGB = rgbSteelBlue
                    .Font.Size = 20
                End With
            End With
        End With
        
    Next i

End Function


Function addAnimation()
    Dim sld As Slide
    Dim shp As Shape
    Dim eft As Effect
    
    Set sld = ActiveWindow.View.Slide
    
    For i = iMax To 1 Step -1
            
        Set shp = sld.Shapes("Oval" & i)
        Set eft = sld.TimeLine.MainSequence.AddEffect(shp, _
            msoAnimEffectFade, , msoAnimTriggerAfterPrevious)
        eft.Exit = msoTrue
        eft.Timing.Duration = 1 / iStep   ' 1초후 사라지게
        
        If i Mod iStep = 0 Then
            Set shp = sld.Shapes("BigOval" & i / iStep)
            Set eft = sld.TimeLine.MainSequence.AddEffect(shp, _
                msoAnimEffectAppear, , msoAnimTriggerAfterPrevious)
            eft.Exit = msoTrue
            'eft.Timing.Duration = 1 / iStep     ' 1초후 사라지게
        End If
    Next i
    
End Function

 

파일 첨부합니다.

1번은 애니메이션이 나타났다 사라지기 방식이고

2번의 4슬라이드이후는 애니메이션이 그냥 사라지는 방식입니다.

타이머원만들기1.pptm

0.07MB

타이머원만들기2.pptm

0.13MB