返回目录：ppt怎么做
Hello，大家好，上次我们谈过关于PPT中通获取PPT的播放状态而进行结束放映时强制退出带延时的Do while….loop循环，今天我们将这种技术用于在PPT中实现时钟的转动。而且在前期我们已经体会到了在excel中实现了时钟的转动效果，那时是利用excel VBA中的Application.OnTime对象的延时功能的情况下实现时钟转动的，而关于PPT VBA是没有这种对象的。怎么办呢？其实，很简单的，我们可以自定义一个延时程序实现。
下面，我们就来一步步搞清楚这些问题。
一、按照以下进行界面设计
图1 界面设计
二、功能代码设计
模块1中代码如下
Public ppt_play_state
Sub OnSlideShowTerminate()
Call Get_PPT_Play_State
MsgBox "时钟即将停止和归位！", , "提示"
Call Stop_Clock
End Sub
Sub Start_Clock()
Dim shp_s As Shape, shp_m As Shape, shp_h As Shape
Set shp_s = ActivePresentation.Slides(1).Shapes(4)
shp_s.Name = "Arrow_s"
Set shp_m = ActivePresentation.Slides(1).Shapes(3)
shp_m.Name = "Arrow_m"
Set shp_h = ActivePresentation.Slides(1).Shapes(2)
shp_h.Name = "Arrow_h"
Do While ppt_play_state = 1
s_offset = Second(Now) * 6
shp_s.Rotation = s_offset
m_offset = Minute(Now) * 6 + Second(Now) / 10
shp_m.Rotation = m_offset
h_offset = (Hour(Now) Mod 12) * 30 + Minute(Now) / 2
shp_h.Rotation = h_offset
delay 0.1 '延时1秒
Loop
End Sub
Sub Stop_Clock()
Dim shp_s As Shape, shp_m As Shape, shp_h As Shape
Set shp_s = ActivePresentation.Slides(1).Shapes(4)
shp_s.Rotation = 0
Set shp_m = ActivePresentation.Slides(1).Shapes(3)
shp_m.Rotation = 0
Set shp_h = ActivePresentation.Slides(1).Shapes(2)
shp_h.Rotation = 0
End Sub
Sub Get_PPT_Play_State()
ppt_play_state = SlideShowWindows(1).View.State
End Sub
Sub delay(t As Single)
Dim t1 As Single
t1 = Timer
Do
DoEvents
Loop While Timer - t1 < t
End Sub
模块1代码注释截图如下
图2 模块1代码注释
Slide1中命令按钮代码
Private Sub start_clock_btn_Click()
Call Get_PPT_Play_State
Call Start_Clock
End Sub
注释如下
图3 Slide1中命令按钮注释
三、PPT中时钟运行界面
1、按<F5>键放映如下图
图4 放映PPT
2、在上面界面点击<开时钟>按钮开启时钟
图5 开启时钟转动
3、按<Esc>键终止PPT放映并让时钟指针归位
图6-1 按<Esc>键终止PPT放映并让时钟指针归位
图6-2 按<Esc>键终止PPT放映并让时钟指针归位
四、小结
虽然PPT VBA没有像excel一样的Application.OnTime对象，但是我们仍然可以自定义一个延时函数进行实现，另外我们利用捕获幻灯片的播放状态（SlideShowWindows(1).View.State）实现了幻灯片放映结束立即时钟停止并归位额情况。
最后，还是希望大家点评和多多关注哦！