如何用VBA编写powerpoint倒计时

Question

我正在尝试在 powerpoint 演示文稿中添加计时器。一旦计时器耗尽，它应该移至下一张幻灯片。

目前我的代码如下所示：

Sub countdown()

Dim time As Date
time = #10/5/2030 9:30:00 AM#
Do Until Hour(time) = Hour(Now()) And Minute(time) = Minute(Now()) And Second(time) = Second(Now())
DoEvents
ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
Loop

SlideShowWindows(1).View.Next
End Sub

问题是我必须手动单击该元素才能启动计时器。有没有一种解决方案可以在幻灯片进入时开始计时并允许我移动到下一张幻灯片而不会使 PowerPoint 崩溃？

是否有使用 Sub OnSlideShowPageChange() 事件处理程序的可能解决方案？我对 VBA 真的很陌生。

谢谢你

Answer 1

我尝试将行为挂钩到 OnSlideShowPageChange 事件

Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)

Do While ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 1 Or ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 6 Or ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 7 Or ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 8
    Dim time As Date
    
    Select Case SSW.View.CurrentShowPosition
     Case 1
            time = #10/5/2030 9:30:00 AM#
     Case 6
            time = #10/5/2030 10:40:00 AM#
     Case 7
            time = #10/5/2030 11:00:00 AM#
     Case 8
            time = #10/5/2030 11:00:00 AM#
    End Select
 
    If Hour(time) = Hour(Now()) And Minute(time) = Minute(Now()) And Second(time) = Second(Now()) Then
        Exit Do
    End If

    DoEvents
    ActivePresentation.SlideShowWindow.View.Slide.Shapes("Countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
Loop
SlideShowWindows(1).View.Next
End Sub

但现在看来该事件已被阻止，如果有人向前移动幻灯片，则不可能结束 == 演示文稿将挂起并出错...

如果循环运行，演示文稿离开当前幻灯片时是否有可能中断的解决方案？

Answer 2

要在 PowerPoint 的 VBA 中编写倒计时计时器，可以使用以下代码：

1. 打开 PowerPoint 并按“Alt + F11”打开 VBA 编辑器。
2. 单击“插入”>“模块”插入新模块。
3. 在模块中，编写以下代码：

Sub StartCountdown()
    Dim TimeInSeconds As Integer
    Dim SlideIndex As Integer
    Dim Slide As Slide
    Dim TextBox As Shape
    
    ' Set the countdown time in seconds
    TimeInSeconds = 60
    
    ' Set the slide index where you want the countdown timer
    SlideIndex = 1
    
    ' Check if the slide index is valid
    If SlideIndex > 0 And SlideIndex <= ActivePresentation.Slides.Count Then
        ' Create or update the countdown timer textbox
        Set Slide = ActivePresentation.Slides(SlideIndex)
        Set TextBox = Slide.Shapes("CountdownTimer")
        If TextBox Is Nothing Then
            Set TextBox = Slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
            TextBox.Name = "CountdownTimer"
        End If
        TextBox.TextFrame.TextRange.Text = TimeInSeconds
        
        ' Start the countdown
        Do While TimeInSeconds > 0
            TextBox.TextFrame.TextRange.Text = TimeInSeconds
            TimeInSeconds = TimeInSeconds - 1
            DoEvents ' Allows the slide to update while counting down
            Application.Wait Now + TimeValue("0:00:01")
        Loop
        
        ' Remove the countdown timer textbox
        TextBox.Delete
    Else
        MsgBox "Invalid slide index."
    End If
End Sub

4. 修改

   TimeInSeconds

   变量以设置所需的倒计时时间。
5. 修改

   SlideIndex

   变量以指定要在其中显示倒计时器的幻灯片。
6. 您也可以通过调整

   Shapes.AddTextbox

   方法中的参数来修改倒计时文本框的位置和大小。
7. 保存 VBA 模块。
8. 要开始倒计时，请按“Alt + F8”打开宏对话框，选择“StartCountdown”，然后单击“运行”。

确保指定幻灯片上有一个名为“CountdownTimer”的文本框形状，以便显示倒计时器。

Answer 3

要在无需手动交互的情况下自动执行计时器，您需要实现 OnSlideShowPageChange 事件处理。您还需要为计时器逻辑编写一个方法来启动倒计时。事件处理应检查当前幻灯片是否是您希望计时器打开的幻灯片。如果是，则调用 StartCountdown 方法。像下面的示例代码块这样的东西应该可以工作。

Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
If Wn.View.CurrentShowPosition = 3 Then ' Assuming you want the timer on slide 3
    Call StartCountdown
End If


End Sub



Sub StartCountdown()
Dim targetTime As Date
targetTime = Now + TimeValue("00:00:10")  

Do Until Now >= targetTime
    DoEvents
    ActivePresentation.SlideShowWindow.View.Slide.Shapes("countdown").TextFrame.TextRange.Text = Format((targetTime - Now), "hh:mm:ss")
Loop

ActivePresentation.SlideShowWindow.View.Next


End Sub

此外，我很好奇您是否探索过实现此类计时器的任何其他方法。替代方法，例如利用 PowerPoint 插件，如 Ubi PowerPoint 计时器（一种基于网络的计时器，类似于 ubiTimer 上的计时器），可以有效地集成到 PowerPoint 中。