使用VBA在PowerPoint中创建倒计时器（续）附示例PPT下载
使用VBA在PowerPoint中创建倒计时器（续）附示例PPT下载
标签：VBA，PowerPoint编程
看看倒计时器的VBA代码：
Dim time As Date
time = Now()
Dim count As Integer
'假设倒计时30秒
count = 30
time = DateAdd("s", count, time)
其中，Now()引用当前日期和时间，将其存储在变量time中，然后加上30秒，因此将time称为未来时间。
注意，DateAdd函数中“s”是添加的时间的单位；count是加多少时间；time是时间基数。也就是说，给time添加30秒。当然，如果想添加30分钟，则将“s”修改为“n”。
在示例中，存储的当前时间是00:00:00，添加30秒的时间后，则变为00:00:30。
再看看代码中的循环结构：
Do Until time < Now()
Loop
这个条件循环更新在矩形形状中的时间文本。条件循环继续，直到Now()大于time。示例中，当前时间从00:00:00到00:00:30时，循环发生，一旦当前时间是00:00:31，循环就会停止，因为当前时间变得大于我们设置的未来时间。
在循环中，下面的语句在矩形形状中更新未来时间和当前时间之差：
ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
一旦当前时间超过未来时间，就可以触发弹出一个消息窗口，通知我们倒计时结束。这可以在Do Loop循环中添加一个if-then条件。当然，也可以在倒计时结束时将演示重定向到某个幻灯片或播放声音效果，而不是使用消息框。
If time < Now() Then
'这里可以添加代码
MsgBox "时间到!"
End If
如果想在幻灯片放映模式下直接更改倒计时值而无须接触VBA代码，可以在幻灯片中添加一个名为TextBox1的ActiveX文本框控件，可以在其中键入希望倒计时的秒数。这个输入将是变量count的值。可以使用以下代码读取输入：
count = ActivePresentation.Slides(1).Shapes("TextBox1").OLEFormat.Object.Value
如果正在创建PPT模板，并希望用户输入自定义时间，可以采用特定形状的文本，并将其作为计数值。也可以将形状放置在幻灯片外部或单独的幻灯片上，这里将此形状命名为TimeLimit。
count = ActivePresentation.Slides(1).Shapes("TimeLimit").TextFrame.TextRange
指定日期或时间的倒计时器代码如下：
Sub CountDownSpecTime()
Dim time As Date
'可以结合实际修改括号里的日期和时间
time = DateSerial(2023, 7, 15) + TimeSerial(3, 0, 0)
Do Until time < Now()
DoEvents
ActivePresentation.Slides(1).Shapes("countdown").TextFrame.TextRange = DateDiff("d", Now(), time) & " Days " & Format((time - Now()), "hh:mm:ss")
Loop
End Sub要在多个PPT幻灯片中嵌入相同的倒计时器，例如，如果是30秒的计时器，并且在10秒后转到下一张幻灯片，则该幻灯片中的计时器应从20开始恢复倒计时。
为此，需要添加一个For循环。i（在本例中为1到3）范围内的所有幻灯片都将更新，直到当前时间超过未来时间。
For i = 1 To 3
ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "ss")
Next i
还可以在PPT放映模式下增加或减少倒计时器。例如，在玩定时游戏时，点击错误答案可以缩短时间限制。类似地，倒计时器也可以增加时间。
初始时，需要在所有过程之上声明变量time，这将允许在其它过程中引用相同的变量。
Global time As Date
Sub CountDownIncrease()
time = Now()
'假设是30秒
time = DateAdd("s", 30, time)
Do Until time < Now()
DoEvents
ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
Loop
End Sub下面的过程将增加或减少倒计时器：
Sub AddTime()
'将计时器增加10秒
time = DateAdd("s", 10, time)
End Sub
Sub SubtractTime()
'将计时器减少10秒
time = DateAdd("s", -10, time)
End Sub如果有一个2分钟的倒计时器，它会显示02:00到00:00。然而，可以编辑代码，通过将格式更改为”ss”只显示秒，但此时会注意到倒计时器只是从60开始，到00结束，并再次重复！这是因为”ss”格式不能显示超过60秒。
可以使用DateDiff函数来解决，使倒计时器从120开始，到0结束。
Sub CountDownSecond()
Dim time As Date
time = Now()
time = DateAdd("s", 120, time)
Do Until time < Now
DoEvents
ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange = DateDiff("s", Now(), time)
Loop
End Sub可以使用下面的VBA代码暂停并恢复PPT倒计时。幻灯片上放置3个形状，单击后将分别运行下列宏：PlayCountDown，PauseCountDown，ResumeCountDown。
Dim time As Date
'倒计时器未来时间
Dim pausedTime As Date '倒计时器暂停时的时间
Dim count As Integer '倒计时值
Dim PauseT As Boolean '计时器是否暂停?
Sub PlayCountdown()
PauseT = False
time = Now()
count = 300 '5分钟倒计时
time = DateAdd("s", count, time)
Debug.Print time
CountDown
End Sub
Sub PauseCountdown()
PauseT = True
pausedTime = time - Now()
count = DateDiff("s", 0, pausedTime)
End Sub
Sub ResumeCountdown()
time = DateAdd("s", count, Now())
CountDown
End Sub
Sub CountDown()
PauseT = False
Do Until time < Now()
DoEvents
If PauseT = False Then ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
Loop
End Sub当单击暂停时，计时器冻结并且使用DateDiff函数计算剩余时间。当倒计时器恢复时，通过将Now()加上剩余时间更新未来时间。
同样，也可以使用VBA代码在PowerPoint中制作显示增加的时间的“计时器”。在这种情况下，有三个不同的部分：time1存储宏运行时的时间；time2存储结束时的未来时间；Now()是动态函数，总是显示当前时间。
例如，如果在午夜00:00:00运行下面30秒计时器的VBA代码，则time1将为00:00:00；time2是00:00:30。
Sub countup()
Dim time1 As Date
Dim time2 As Date
time1 = Now()
time2 = Now()
Dim count As Integer
'假设是30秒
count = 30
time2 = DateAdd("s", count, time2)
Do Until time2 < Now()
DoEvents
ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange = Format((Now() - time1), "hh:mm:ss")
Loop
End Sub形状中的文本是当前时间（不断增加）和time1（恒定：代码运行时的时间）之间的差值，因此，随着差值不断扩大，将进行递增计时，直至循环到当前时间大于time2。