PPT插入计时器

微软或WPS的PPT软件里只能插入当前系统时间，不明白为什么不设计一个类似秒表计时器的功能，毕竟这个功能非常实用。在网上搜索良久，开始采用在PPT里插入Flash动画计时器，虽然有不少现成的Flash可供下载，而想要定制理想的计时器还得会Flash编程的相关知识，而且这个方法有个严重的缺陷，一旦演示PPT时翻页过快，Flash动画计时器会莫名地卡死；后来采用推荐众多的PPT宏，但是网上下载的许多宏都是加密的，无法查看源代码，于是搜索VBA编程相关的教程，东拼西凑出下面的代码，欢迎大家更改和完善！

PPT 2007下，新建空白文档->开发工具->Visual Basic，VBAProject右键->插入->模块

在右边空白编辑区输入如下代码

Option Explicit
'声明api函数，使用定时器
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
   

Dim flag As Boolean
Dim oSh As Shape
Dim count As Integer '总共的秒数
Dim h As Integer '时
Dim m As Integer '分
Dim s As Integer '秒
                 
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    count = count + 1

    s = count Mod 60
    m = (count \ 60) Mod 60
    h = count \ 3600
    oSh.TextFrame.TextRange.Text = TimeSerial(h, m, s)
    
End Sub

Public Sub OnSlideShowPageChange()
    
    If flag = False Then '让下面的代码只执行一次
       flag = True

    '向母版添加文本框
    With ActivePresentation
      
        Set oSh = _
            .Designs(1).SlideMaster.Shapes.AddTextbox( _
            msoTextOrientationHorizontal, _
            .PageSetup.SlideWidth - 75, _ 
            .PageSetup.SlideHeight - 25, _ 
            75, 
            25)                           
           
            oSh.Name = "TimeCount"
            
             With oSh.TextFrame.TextRange
                .Font.Name = "Arial"     '文本框字体
                .Font.Size = 12          '文本框字体大小
                .Text = "0:00:00"        '文本框文字
            End With
        
    End With
    
    '启动计时器
    Dim id As Long
    id = SetTimer(0, 0, 1000, AddressOf TimerProc)
	
    End If
 
End Sub

文档另存为->其他格式->.ppa文件

使用时，用PPT 2007打开一个文档，开发工具->宏安全性->宏设置->启用所有宏->确定

Office按钮->PowerPoint选项->加载项->PowerPoint加载项->转到

在弹出的窗口中添加刚保存的.ppa文件，关闭窗口，然后开始放映PPT，翻页后才可以看到右下角的计时器。

但是有个bug，每次翻页时计时器总会显示前一个时间点，再显示当前计时点，如果大家有好的解决方案欢迎留言。

或者在PPT母版里面添加文本框(ActiveX控件)，然后在TimerProc方法中更新文本框显示计时，这样可以避免上述问题，但是会出现一个新问题，文本框的背景色不能透明。

如果将上述VBA代码添加到PPT文档里再另存为PPT文件，那么播放该PPT时就无需加载.ppa文件，当然前提都要设置PPT2007启用所有宏