用VBA实现PPT倒计时

代 码：

Private Declare Function GetTickCount Lib “kernel32.dll” () As Long
Private Declare Sub Sleep Lib “kernel32.dll” (ByVal dwMilliseconds As Long)
Private Declare Function PlaySound Lib “winmm.dll” Alias “sndPlaySoundA” (ByVal lpszName As String, ByVal uFlags As Long) As Long
Const InterVal = 1000 ‘自定义的时间间隔
Dim myStop As Boolean ‘中断计时标识

Private Sub CommandButton1_Click() ‘倒计时开始及中断按钮
Dim preTime, curTime, myTime, jsTime, txTime As Long

Select Case CommandButton1.Caption
Case “开始倒计时”
CommandButton1.Caption = “停止倒计时”
preTime = GetTickCount ‘获得计时开始初始时间
myTime = Val(TextBox2) + 1 ‘所余倒计时时间
jsTime = Val(TextBox2) + 2 ‘总倒计时时间
txTime = Val(TextBox3) ‘倒计时结束前提醒时间
Label3.Visible = False ‘隐藏倒计时输入提示标签
Label4.Visible = False ‘隐藏计时结束前提醒时间输入标签
TextBox2.Visible = False ‘隐藏输入倒计时时间(秒)文本框
TextBox3.Visible = False ‘隐藏输入计时结束前提醒(秒)文本框
Label2.Caption = “计时进行中” ‘计时状态提示标签
Do
curTime = GetTickCount ‘获得当前时间
If curTime – preTime >= InterVal * (jsTime – myTime) Then
myTime = myTime – 1
TextBox1 = myTime ‘显示所余倒计时秒数
DoEvents ‘转让控制权，以便让操作系统处理其它的事件
If myTime = txTime Then
Label2.Caption = “计时将结束”
Call PlaySound(“Ding.wav”, 0&) ‘计时将结束提示音
End If
If myTime = 0 Then
Label2.Caption = “计时时间到”
CommandButton1.Caption = “开始倒计时”
Call PlaySound(“End.wav”, 0&) ‘计时结束提示音
Exit Do
End If
End If
Sleep (20) ‘延时暂停20毫秒
Label1 = Time ‘倒计时中系统实时时间提示标签
DoEvents
If myStop Then
myStop = False
Label2.Caption = “计时被中断”
CommandButton1.Caption = “开始倒计时”
MsgBox “倒计时终止！”, vbInformation + vbOKOnly, “操作提示”
Exit Do
End If
Loop
Case “停止倒计时”
myStop = True
End Select

Label3.Visible = True ‘显示倒计时输入提示标签
Label4.Visible = True ‘显示计时结束前提醒时间输入标签
TextBox2.Visible = True ‘显示输入倒计时时间(秒)文本框
TextBox3.Visible = True ‘显示输入计时结束前提醒(秒)文本框

End Sub

演示图：

附件下载：

文件名称：用VBA实现PPT倒计时.PPT
附属文件：Ding.wav、End,wav

http://www.accessoft.com/article-show.asp?id=5493 里下载。