vba - Powerpoint 中的实时时钟

Question

我正在为信息亭制作循环 PowerPoint。此演示文稿的每张幻灯片都需要一个实时时钟。我已经找到了一种方法来做到这一点，但不幸的是它不适用于无人演示。

我目前在每张幻灯片上都有一个分配给下面宏的形状。形状是幻灯片的整个大小，并且不包含填充。我知道如何执行宏的唯一方法是使用“操作”选项并将鼠标悬停或单击鼠标。我在鼠标上分配了它，当我移动鼠标时它适用于每张幻灯片。在 PowerPoint 或 VBA 中是否有解决方法可以独立运行？

 Sub digitalClock()
 Dim time As Date
 Dim minutes As Integer

 time = Now()
 minutes = 60

 time = DateAdd("n", minutes, time)

 Do Until Now() = time
  DoEvents

  With ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange
    .Text = Format(Now(), "hh:mm:ss")
  End With

 Loop

 End Sub

编辑：（我不知道这是否是正确的方法，我很抱歉）

这几乎可以工作，但它不符合我在幻灯片上具有正确文本格式的形状，如最后一个宏。它只是在当前幻灯片的顶部插入时间。我还必须手动前进，它不会在下一张幻灯片上运行。

Sub OnSlideShowPageChange()
Dim i As Integer
Dim time As Date
Dim minutes As Integer

time = Now()
minutes = 60
time = DateAdd("n", minutes, time)
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition

Do Until Now() = time
DoEvents

With ActivePresentation.Slides(i).Shapes(1).TextFrame.TextRange
    .Text = Format(Now(), "hh:mm:ss")
End With
Loop
End Sub

标签： vbapowerpoint