用VBA在PowerPoint中实现日期时间秒级动态显示

'*********************************************************** 使用说明 *********************************************************
'把此文本写入PowerPoint的VBA的宏里面，然后把PPT保存为PPT的ppam文件，在PPT“开发工具”里加载项中添加该ppam文件。
'PowerPoint需要的设置：
' 1、文件/选项/信任中心/信任中心设置/启用所有宏。
' 2、开发工具/加载项/添加，加入上述ppam文件。
'以后，只要在某个幻灯片中插入文本框TimeText，那么该文本框就会显示当前日期时间。
'*******************************************************************************************************************************

'***************** 定义与声明 ****************
#If VBA7 Or Win64 Then
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#Else
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

Public index As Integer
Public temp As Shape
Public ID As Integer
Public SlideNO As Integer

'***************** 计时器 ********************
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)

temp.TextFrame.TextRange.Text = Format(Date, "YYYY.MM.DD") & " " & Format(Time, "HH:MM:SS")

End Sub

'************* 放映时显示日期时间 **************
Public Sub OnSlideShowPageChange()

SlideNO = ActivePresentation.SlideShowWindow.View.CurrentShowPosition

If Not ActivePresentation.Slides(SlideNO).Shapes("TimeText") Is Nothing Then

If ID > 0 Then

temp.TextFrame.TextRange.Text = ""
tt = KillTimer(0, ID)
ID = 0

End If

If ID <= 0 Then

ID = SetTimer(win_hwnd, 1000, 1000, AddressOf TimerProc)
Set temp = ActivePresentation.Slides(SlideNO).Shapes("TimeText")
temp.ZOrder (msoBringToFront)
temp.TextFrame.TextRange.Text = ""

Else

temp.TextFrame.TextRange.Text = ""

End If

End If

End Sub

'************** 结束放映时处理 ****************
Public Sub OnSlideShowTerminate()

tt = KillTimer(0, ID)
ID = 0

ActivePresentation.Saved = msoTrue

End Sub