|
|
一
- 'CTimer类模块：
- '申明API函数
- Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
- Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
- Private TimerID As Long
- Public WithEvents thisApp As Application
- Private Sub thisApp_SlideShowBegin(ByVal Wn As SlideShowWindow)
- Dim prompt As String
- prompt = " 演讲时间以分钟为单位,最长不超过300分钟。" _
- & vbCrLf & " 无意义输入，视同取消。" _
- & vbCrLf _
- & vbCrLf & " 叶鹏" _
- & vbCrLf & " yehpeng@sohu.com" _
- & vbCrLf & " 宁波职业技术学院" _
- & vbCrLf & " 2006年10月11日"
- Duration = Val(InputBox(prompt, "演讲倒计时", "45"))
-
- '将演讲时间单位转换为秒
- If Duration <= 0 Then
- Exit Sub
- 'Duration = 45 * 60
- ElseIf Duration > 300 Then
- Duration = 300 * 60
- Else
- Duration = Duration * 60
- End If
-
- '在母板上添加一个文本框，用以显示时间；该文本在结束放映时被删除。
- Dim txtShowTime As Shape
- Set txtShowTime = ActivePresentation.SlideMaster.Shapes.AddTextbox(msoTextOrientationHorizontal, ActivePresentation.SlideMaster.Width - 100, 10, 110, 40)
- '设置该文本框的Name属性
- txtShowTime.Name = "Timer"
- '设置该文本框的文本格式
- txtShowTime.TextFrame.TextRange.Text = "倒计时"
- With txtShowTime.TextFrame.TextRange.Font
- .Name = "New Time Roman"
- .Size = 20
- .Bold = msoTrue
- .Color.RGB = RGB(255, 50, 0)
- End With
-
- '创建定时器，触发时间为1秒，到时执行TimerProc过程
- TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
- If TimerID = 0 Then
- ActivePresentation.SlideMaster.Shapes("Timer").Delete
- MsgBox "由于系统原因，不能创建定时器！"
- Exit Sub
- End If
-
- End Sub
- Private Sub thisApp_SlideShowEnd(ByVal Pres As Presentation)
- If TimerID <> 0 Then
- '终止定时器
- TimerID = KillTimer(0, TimerID)
- '删除时间显示文本框
- ActivePresentation.SlideMaster.Shapes("Timer").Delete
- End If End Sub
复制代码
二
- 'modAutoMacro模块：
- Public thisPPT As New CTimer
- Public Duration As Long '演讲时间
- Sub Auto_Open()
-
- ' 启动PowerPoint时可以自动运行的宏
- Set thisPPT.thisApp = Application
-
- End Sub
- Sub Auto_Close()
-
- ' 关闭PowerPoint时可以自动运行的宏
- Set thisPPT.thisApp = Nothing
-
- End Sub
- '定时器到时的时候要执行的过程
- Public Sub TimerProc()
-
- 'DoEvents
-
- '剩余的秒数
- Duration = Duration - 1
- '将剩余的秒数转换为"时：分：秒"的格式
- '小时数
- h = Int(Duration / 3600)
-
- temp = Duration Mod 3600
-
- '分钟数
- m = Int(temp / 60)
- '秒数
- s = temp Mod 60
-
- '函数TimeSerial将小时数、分钟数、秒数合并成时间格式
-
- If TimeSerial(h, m, s) <= TimeSerial(0, 0, 0) Then
- '退出放映
- ActivePresentation.SlideShowWindow.View.Exit
- Else
- '在文本框中显示时间
- ActivePresentation.SlideMaster.Shapes("Timer").TextFrame.TextRange.Text = Format(TimeSerial(h, m, s), "hh:mm:ss")
- End If End Sub
复制代码
|
|
