幻灯片里的定时器

　　在幻灯片里有时候会用到定时器，比如我们需要定时执行一些特殊任务，如让一幅图片慢慢地消失或者显现，即淡入淡出，虽然通过设置图片的动画可以做到，但是通过程序可以控制得更为理想。
　　首先，定义API
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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

Public TimerID As Long
Public LTimerCount As Long
Public FTMD As Single    '定义通明度

'开启定时器
Sub 开启定时器()
    FTMD = 0#
    LTimerCount = 0
    TimerID = SetTimer(0, 0, 200, AddressOf TimerProc)
End Sub

'定时器执行
Sub TimerProc(ByVal hwnd As Long,ByVal uMsg As Long,ByVal idEvent As Long,ByVal dwTime As Long)
        LTimerCount = LTimerCount + 1
        慢慢消失
        If (LTimerCount >= 12) Then
            TimerID = KillTimer(0, TimerID)
            '幻灯片跳转
            ActivePresentation.SlideShowWindow.View.GotoSlide 3
        End If       
End Sub

'淡出
Sub 慢慢消失()
    If FTMD < 0.99 Then
       FTMD = FTMD + 0.1
    End If
    If FTMD > 1 Then FTMD = 0.99
    ActivePresentation.Slides(1).Shapes(2).Fill.Transparency = FTMD
End Sub

'下面的程序经常用到：即得到对象ID
Dim SObjectWebName As String
Dim i As Integer
Dim FindDestObject As Object

Set FindDestObject = ActivePresentation.Slides(3)

SObjectWebName = "文本显示"
   
For i = 1 To FindDestObject.Shapes.Count
    If FindDestObject.Shapes(i).AlternativeText = SObjectWebName Then
       MsgBox i
       Exit For
    End If
Next

　　这样的效果在很多幻灯片中可以用到，比如在开始的时候，标题文字淡出，再淡入，中间用程序更换背景，那么用户看到的就是文字从画面上淡出，再淡入，再进入主题（即可以在主题页面上进行自然切换），效果很好。