( 파워포인트 VBA ) 슬라이드별로 카운트다운하는 ppt 만들었는데

다음슬라이드로 넘어갈 때 Pause 버튼을 안누르고 넘어가는 경우 계속 타이머가 작동하므로

페이지가 변할 때마다 PauseT 값을 True로 바꿔줘야 합니다.

​

슬라이드별 기본 시간은 코드에 넣는 것 보다는

각 슬라이드의 타이머 도형의 이름에 입력하는 방식으로 바꿨습니다.

countdown_120이면 00:02:00 즉, 2분입니다.

슬라이드쇼를 종료하면 각 슬라이드의 타이머시간을 초기화시키도록 했습니다.

갑자기 종료하는 경우 안될 수도 있습니다.

​

ActivePresentation.SlideShowWindow.View.Slide 같은 긴 코드를 피하도록 했습니다.

​

실행화면

​

수정된 코드:

Option Explicit Dim timeT As Date ' 카운트다운 종료 시간 'Dim pausedTime As Date ' 일시 정지된 시간 Dim PauseT As Boolean ' 타이머가 일시 정지되었는지 여부 Sub PlayCountdown(oShp As Shape) Dim cshp As Shape Dim csld As Slide Dim countT As Integer ' 카운트다운 값 Set csld = oShp.Parent PauseT = False ' 각 슬라이드별로 다른 카운트다운 시간 설정 ' 추가적인 슬라이드에 대한 설정은 슬라이에 타이머 도형이름을 countdown_xxx 로 수정 Set cshp = getCountShape(csld) If Not cshp Is Nothing Then countT = CInt(Split(cshp.Name, "_")(1)) ' 현재 시간에 카운트다운 시간을 더하여 종료 시간 설정 timeT = DateAdd("s", countT, Now()) 'timeT = Now() + TimeSerial(0, 0, countT) ' 디버그 출력 'Debug.Print time ' 카운트다운 시작 countdown csld End Sub ' 해당 슬라이드에서 타이머 도형 찾기 Function getCountShape(sld As Slide) As Shape Dim shp As Shape For Each shp In sld.Shapes If shp.Name Like "countdown_*" Then Set getCountShape = shp Exit Function End If Next shp End Function Sub PauseCountdown() PauseT = True 'pausedTime = timeT - Now() 'countT = DateDiff("s", 0, pausedTime) End Sub Sub ResumeCountdown(oShp As Shape) Dim cshp As Shape Dim csld As Slide Set csld = oShp.Parent Set cshp = getCountShape(csld) If cshp Is Nothing Then Exit Sub 'timeT = DateAdd("s", TimeValue(cshp.TextFrame.TextRange) * 86400, Now()) timeT = Now() + TimeValue(cshp.TextFrame.TextRange) 'Debug.Print timeT countdown csld End Sub Sub countdown(osld As Slide) Dim tshp As Shape PauseT = False Set tshp = getCountShape(osld) If tshp Is Nothing Then Exit Sub Do Until timeT < Now() DoEvents If PauseT = False Then ' 슬라이드별로 타이머 텍스트 상자에 카운트다운 값 표시 tshp.TextFrame.TextRange = Format((timeT - Now()), "hh:mm:ss") End If ' 슬라이드 쇼 종료시 종료 If SlideShowWindows.count = 0 Then Exit Sub Loop End Sub ' 슬라이드쇼가 종료될 때 호출 Sub OnSlideShowTerminate(SSW As SlideShowWindow) resetSlides End Sub ' 슬라이드가 바뀔 때마다 호출 Sub OnSlideShowPageChange(SSW As SlideShowWindow) ' If SSW.View.Slide.SlideIndex = 1 Then ' Call resetSlides ' End If PauseT = True '페이지가 바뀌면 정지 End Sub '모든 슬라이드의 타이머 시간표시를 초기화 Sub resetSlides() Dim tshp As Shape Dim tsld As Slide For Each tsld In ActivePresentation.Slides Set tshp = getCountShape(tsld) If Not tshp Is Nothing Then tshp.TextFrame.TextRange = _ Format(TimeSerial(0, 0, CInt(Split(tshp.Name, "_")(1))), "hh:mm:ss") End If Next tsld End Sub

첨부파일 참고하시고 아래 관련 링크도 참고하세요.

​

​

아래 방법들은 외부 Timer API를 이용하였습니다.

​

슬라이드 자동전환 타이머

https://kin.naver.com/qna/detail.naver?d1id=1&dirId=102020103&docId=436733651&qb=7YOA7J2066i4&enc=utf8&section=kin.qna&rank=2&search_sort=0&spq=0

파워포인트 타이머 자동전환 슬라이드 만들기....

https://kin.naver.com/qna/detail.naver?d1id=1&dirId=102020103&docId=405849814&qb=7Iqs652...

kin.naver.com

Timer API를 이용한 각 슬라이드 별 타이머

https://kin.naver.com/qna/detail.naver?d1id=1&dirId=102020103&docId=405849814&qb=7YOA7J2066i4&enc=utf8&section=kin.qna&rank=1&search_sort=0&spq=0

타이머 ppt

기존 피피티 연속슬라이드에 타이머 페이지를 삽입하려면 어떻게 해야 하나요?총 4슬라이드에 연달아 타이머 넣어서 슬라이드 다음페이지로 넘어갈수있게도 해야하는데 안됩니다ㅠ현재로서는 A...

kin.naver.com

타이머 누적 기록

https://kin.naver.com/qna/detail.naver?d1id=1&dirId=102020103&docId=387844041&qb=7YOA7J2066i4&enc=utf8&section=kin.qna&rank=4&search_sort=0&spq=0

파워포인트 VBA 타이머, 리스트 질문

파워포인트 2013을 쓰고 있습니다. 파워포인트 VBA로, 위에는 타이머, 아래에는 리스트(추가, 삭제 가능한 것)을 넣고 싶은데 어떻게 하면 되나요?

kin.naver.com

모든 슬라이드에 하나의 타이머를 계속 표시하는 예제

https://konahn.tistory.com/entry/PPTrealtimeclockv2

PPT 실시간 시계 혹은 타이머 추가 v2

지난 버전에 이어서 이번에는 첫슬라이드에 시계 도형을 만들 필요 없이 전부 VBA로 clock 시계도형을 추가하도록 수정해보았습니다. 사용자가 할 일은 아래의 VBA코드를 복사해서 사용자의 PPT 의 Alt-F11 VBE 코드창에 붙여넣는 것 뿐입니다. 구체적으로 말하자면 파워포인트 일반편집창에서 'Alt-F11'키 눌러서 VBE코드창 연 다음 [삽입 - 모듈] 메뉴에서 '모듈'을 하나 추가하고 아래에서 복사한 코드를 붙여넣고 F5 슬라이드쇼 테스트 한번 하면 됩니다. 혹시나 시계가 시작하지 않는다면 Alt-F8 누르고 'First...

konahn.tistory.com

​