自动加载宏实现的演讲倒计时，想看源代码
这是一个加载宏，可以实现倒计时功能。我很想学习，可惜与作者联系不上，不知有没有高手帮忙看一下。
回复我，就能看到代码。
我信你呢，请大神多多指教 一
[*]'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
复制代码
二
[*]'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
复制代码
抱歉，我发了多次，帖子需要审核，第一部分，发不上去。 我重新做了下，不是原来的了，你只看代码吧
非常感谢，很好的学习材料，谢谢
home可能被攻击了，附件无法下载
页:
[1]