在幻灯片里有时候会用到定时器,比如我们需要定时执行一些特殊任务,如让一幅图片慢慢地消失或者显现,即淡入淡出,虽然通过设置图片的动画可以做到,但是通过程序可以控制得更为理想。
首先,定义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
这样的效果在很多幻灯片中可以用到,比如在开始的时候,标题文字淡出,再淡入,中间用程序更换背景,那么用户看到的就是文字从画面上淡出,再淡入,再进入主题(即可以在主题页面上进行自然切换),效果很好。