刘瑞祥

例：利用程序实现平抛运动。

　　本例中的多数代码必须在放映幻灯片时运行，因此如果是2007或者更高版本，需要保存为“启用宏的Powerpoint文稿（*.pptm）”。

　1、输入如下代码。

'''''''''''''''''''''''''''''''''''''''''''''

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

'''''''''''''''''''''''''''''''''''''''''''''

Sub moveOval ( )

        Dim j As Integer

        If j =100 Then

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

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

               j =0

               For j =0 To 99

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

              Next

         Else If j=0 Then

                    StartTimer 10

j=j+1

         End If

End Sub

'''''''''''''''''''''''''''''''''''''''''''''

Sub StartTimer(lDuration As Long)

          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

'''''''''''''''''''''''''''''''''''''''''''''

Sub OnTime( )

          Dim x1 As Single, x2 AsSingle, y1 As Single, 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

End Sub

　　第一段程序引入定时器的API函数，并定义两个全局变量。第二段程序是绘制一个小球并命名（本段运行一次以后可以删掉）。第三段程序，如果i=0，则启动定时器（本例StartTimer 10表示每10毫秒触发一次定时器事件，即执行一次后面的OnTime函数，i=100则重新初始化程序。第四段程序是停止定时器。第五段——也就是最后一段程序——移动小球并画出一条轨迹，当i=100时终止程序。cm2p函数见 前文(单击这里可跳转)的灰色部分。 

　　以上在画图的同时给画图对象命名，这样做的目的是，以后可以方便地通过名字操作所绘制的对象。

　2、先在设计视图下执行前面的第一段程序，再绘制一个矩形作为按钮。

　3、选中刚才绘制的矩形，在“插入”选项卡里单击“动作”按钮，弹出对话框。单击“运行宏”，然后在下拉框里选择moveOval，即可放映运行。

　　本文是在运行时逐段画出轨迹的，也可以在画出小球时同时画出抛物线轨迹（用AddPolyLine方法），并画一与背景颜色相同的矩形盖住轨迹，然后在运行时同时移动小球和矩形。

　　本例除了大部分代码需要在ppt放映时运行外，还有一点要注意的是，就是当放映运行一次以后返回到设计界面，小球仍然停留在放映运行以后的位置。