使用VBA在PowerPoint中创建倒计时器(续)附示例PPT下载

2023-08-30 08:40:21 浏览数 (1)

接上篇:使用VBA在PowerPoint中创建倒计时器

标签: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

指定日期或时间的倒计时器代码如下:

代码语言:javascript复制
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,这将允许在其它过程中引用相同的变量。

代码语言:javascript复制
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

下面的过程将增加或减少倒计时器:

代码语言:javascript复制
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结束。

代码语言:javascript复制
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。

代码语言:javascript复制
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。

代码语言:javascript复制
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。

0 人点赞