'引入定时器的API函数，并定义两个全局变量。

Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hwnd As Long , ByVal nIDEvent As Long , ByVal uElapse As Long , ByVal lpTimerFunc As Long ) As Long

Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hwnd As Long , ByVal nIDEvent As Long ) As Long

Public lTimerID AsLong , i As Integer

'绘制一个小球并命名（本段运行一次以后可以删掉），命名的原因是以后可以方便地通过名字操作所绘制的对象。

Public Sub drawOval ( )

         Dim shp As Shape

         ActivePresentation.Slides(1).Shapes.AddShape( _
             msoShapeOval, cm2p(1), cm2p(1), cm2p(1), cm2p(1)).Name="o1"

End Sub

'如果i=0，则启动定时器（本例StartTimer 10表示每10毫秒触发一次定时器事件，即执行一次后面的OnTime函数，i=100则重新初始化程序。

Sub moveOval ( )

        Dim j As Integer

        If i =100 Then

               ActivePresentation.Slides(1).Shapes("o1").Left= cm2p(1)

               ActivePresentation.Slides(1).Shapes("o1").Top= cm2p(1)

                   i =0

               For j =0 To 99

                   ActivePresentation.Slides(1).Shapes("line"& j).Delete

              Next

         Else If i =0 Then

                    StartTimer 10

         End If

End Sub

'启动计时器

Sub StartTimer(lDuration AsLong)

          If lTimerID =0 Then

                lTimerID =SetTimer(0&,0&, lDuration,AddressOfOnTime)

           Else

                     Call StopTimer

                     lTimerID =SetTimer(0&,0&, lDuration,AddressOfOnTime)

          End If

End Sub

'停止定时器。

Sub StopTimer()

          KillTimer0&, lTimerID

End Sub

'移动小球并画出一条轨迹，当i=100时终止程序。

Sub OnTime( )

          Dim x1 AsSingle, x2 AsSingle, y1 AsSingle, y2 As Single

          x1 =ActivePresentation.Slides(1).Shapes("o1").Left+cm2p(0.5)

          y1 =ActivePresentation.Slides(1).Shapes("o1").Top+cm2p(0.5)

          ActivePresentation.Slides(1).Shapes("o1").Top= cm2p(1+ i * i /1000)

          ActivePresentation.Slides(1).Shapes("o1").Left= cm2p(1+ i /10)

          x2 =ActivePresentation.Slides(1).Shapes("o1").Left+cm2p(0.5)

          y2 =ActivePresentation.Slides(1).Shapes("o1").Top+cm2p(0.5)

          ActivePresentation.Slides(1).Shapes.AddLine(x1, y1, x2, y2).Name="line"& i

         i = i +1

         If i =100 Then StopTimer

EndSub

'实现厘米转化为“磅”。

Private Function cm2p(cm As Single) As Single
    cm2p = cm * 28.35
End Function