ppt 스톱워치 - 타이머 누적 기록

 

상단에는 시계가 돌아가고

Start 를 누르면 타이머(스톱워치)가 작동하고

Record 를 누를 때마다 현재 시간을 기록하고 누적합니다.

타이머 시간을 누르면 잠시 일시정지 혹은 재시작합니다.

Reset 을 누르면 초기화 합니다.

누적 된 타이머 기록은 타이머 아래 텍스트 상자에 쌓이게 됩니다.

 

 

Option Explicit

#If VBA7 Then
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Public TimerID As LongPtr                      '다른 타이머와 구별하기 위한 타이머의 고유ID(번호)
#Else
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Public TimerID As Long                      '다른 타이머와 구별하기 위한 타이머의 고유ID(번호)
#End If

Const Default As Integer = 1                '시간을 출력할 슬라이드 번호

Private TimerCount As Single                  '타이머 카운트
Private TimerStarted As Boolean                     '타이머 일시정지용
Private TimerPause As Boolean

Sub StartNow()

    TimerCount = 0
    TimerStarted = True
    ActivePresentation.Slides(Default). _
        Shapes("Timer").TextFrame.TextRange.Text = Format(0, "hh:mm:ss")
    Slide1.TextBox1.Text = ""
    'StartTimer
    
End Sub

Sub RecordNow()
    If TimerCount > 0 Then _
        Slide1.TextBox1.Text = Format(TimerCount / 86400, "hh:mm:ss") & vbNewLine & Slide1.TextBox1.Text
    
End Sub

Sub StopNow()
    
    'StopTimer
    TimerStarted = False
    TimerCount = 0
    ActivePresentation.Slides(Default). _
        Shapes("Timer").TextFrame.TextRange.Text = Format(0, "hh:mm:ss")
    Slide1.TextBox1.Text = ""
    
End Sub

Sub myTimer()
'1초마다 실행되는 함수로 절대 에러가 나서는 안됨.
'스스로를 호출하는 경우 에러 발생 가능성 높음.
    On Error Resume Next
    
    ActivePresentation.Slides(Default). _
        Shapes("Clock").TextFrame.TextRange.Text = Format(Time, "hh:mm:ss")
        
    If TimerPause Then Exit Sub
    If Not TimerStarted Then Exit Sub
    
    TimerCount = TimerCount + 1
    
    ActivePresentation.Slides(Default). _
        Shapes("Timer").TextFrame.TextRange.Text = Format(TimerCount / 86400, "hh:mm:ss")
    
End Sub


'타이머를 시작 - 슬라이드 쇼 종료전 반드시 StopTimer(KillTimer) 해줘야 함.
Function StartTimer()
     
    If TimerID = 0& Then                                    ' 타이머 ID가 비어 있으면 타이머 시작
        TimerID = SetTimer(0&, 0&, 1000&, AddressOf myTimer)  ' 세번째 인수가 인터벌 간격(1000 = 1초)

    End If
End Function

'타이머를 종료
Function StopTimer()
    On Error Resume Next
    KillTimer 0&, TimerID       ' 타이머 서비스를 종료
    TimerID = 0&                ' 타이머ID도 초기화

End Function

'타이머를 잠시 중단
Sub PauseTimer()
    TimerPause = Not TimerPause
End Sub

'쇼 종료시 자동 실행
Public Sub OnSlideShowTerminate(SSW As SlideShowWindow)
    
    StopTimer ' 종료시 타이머 종료하지 않으면 치명적 에러발생 유의!
    StopNow
End Sub

'슬라이드가 시작하면 자동으로 타이머 시작
Public Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

     If ActivePresentation.SlideShowWindow.View.CurrentShowPosition = Default Then
        StartTimer
    Else
        StopTimer
    End If
End Sub

 

파일 첨부합니다. 차단해제 후 매크로 컨텐츠 허용하세요.

파워포인트 2019(64비트버전)에서 테스트했습니다.

 

TimerRecordSample1.pptm

0.09MB

 

깜빡이는 버전을 추가합니다.

TimerRecordSample2.pptm

0.10MB