ACC2000: Como diapositivos de apresentação Microsoft PowerPoint num formulário

' Initialize variables.
Const firstSlide = 1
Dim arrSlideID() As Long
Dim pptobj As Object
Dim slideindex As Long, slidecount As Long
						

Sub ErrHandler()

   Dim strError As String
   Dim errObj As Error
   strError = " "
   If DBEngine.Errors.Count > 0 Then
      For Each errObj In DBEngine.Errors
         strError = strError & Format$(errObj.Number)
         strError = strError & " : " & errObj.Description
         strError = strError & " (" & errObj.Source & ") . "
         strError = strError & Chr$(13) & Chr$(10)
      Next
      MsgBox strError
   Else
      MsgBox "Error: " & Err & " " & Error
   End If

End Sub
					

Private Sub Form_Load()
   On Error GoTo Form_Load_Error
   Dim i As Integer
   Dim holder As Long, present As Object

   ' Start Powerpoint and open an existing presentation.
   holder = Shell("c:\Program Files\Microsoft Office\Office\Powerpnt.exe")
   Set pptobj = CreateObject("PowerPoint.Application")
   Set present = pptobj.Presentations.Open _
      ("c:\Program Files\Microsoft Office\Office\Pptexample.ppt")

   ' Determine the number of slides in the presentation.
   slideCount = present.Slides.Count
   
   ' Fill an array with all Slide IDs.
   ReDim arrSlideID(1 To slideCount)
   For i = 1 To slideCount
     arrSlideID(i) = present.Slides(i).SlideID
   Next i

   ' Close the presentation.
   pptobj.Presentations _
      ("c:\Program Files\Microsoft Office\Office\Pptexample.ppt").Close
   Set present = Nothing
   Exit Sub

Form_Load_Error:
   ErrHandler
   Exit Sub
End Sub
					

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Form_Unload_Error

   ' Close Powerpoint.
   pptobj.Quit

Exit Sub

Form_Unload_Error:
   ErrHandler
   Exit Sub
End Sub
					

Private Sub insertShow_Click()
   On Error GoTo insertShow_Click_Error

   ' Make object frame visible and enable "navigation" buttons.
   pptFrame.Visible = True
   frstslide.Enabled = True
   lastslide.Enabled = True
   nextslide.Enabled = True
   previousslide.Enabled = True

   ' Specify OLE Class, Type, SourceDoc, SourceItem and other
   ' properties.
   With pptFrame
      .Class = "Microsoft Powerpoint Slide" 
      .OLETypeAllowed = acOLELinked
      .SourceDoc = "c:\Program "_
      & "Files\Microsoft Office\Office\Pptexample.ppt"
      .SourceItem = arrSlideID(FIRSTSLIDE)
      .Action = acOLECreateLink
   End With

   ' Set slide index to the first slide.
   slideindex = FIRSTSLIDE
   frstSlide.setfocus
   insertShow.enabled=false

   Exit sub

insertShow_Click_Error:
   ErrHandler
   Exit Sub
End Sub
					

Private Sub frstSlide_Click()
   On Error GoTo frstSlide_Click_Error

   ' Set SourceItem property to first slide and create a link.
   With pptFrame
      .SourceItem = arrSlideID(FIRSTSLIDE)
      .Action = acOLECreateLink
   End With

   slideindex = FIRSTSLIDE

   Exit Sub

frstSlide_Click_Error:
   ErrHandler
   Exit Sub
End Sub
					

Private Sub nextSlide_Click()
   On Error GoTo nextSlide_Click_Error

   ' Determine if current slide is last slide.
   If slideindex < slidecount Then
      slideindex = slideindex + 1

      ' Set SourceItem property to next slide and create a link.
      With pptFrame
         .SourceItem = arrSlideID(slideindex)
         .Action = acOLECreateLink
      End With
   Else
      MsgBox "This is the last slide."
   End If

   Exit Sub

nextSlide_Click_Error:
   ErrHandler
   Exit Sub
End Sub

					

Private Sub previousSlide_Click()
   On Error GoTo previousSlide_Click_Error

   ' Determine if current slide is first slide.
   If slideindex > FIRSTSLIDE Then
      slideindex = slideindex - 1

      ' Set SourceItem property to previous slide and create a link.
      With pptFrame
         .SourceItem = arrSlideID(slideindex)
         .Action = acOLECreateLink
      End With
   Else
      MsgBox "This is the first slide."
   End If

   Exit Sub

previousSlide_Click_Error:
   ErrHandler
   Exit Sub
End Sub

					

Private Sub lastSlide_Click()
   On Error GoTo lastSlide_Click_Error

   ' Set SourceItem property to previous slide and create a link.
   With pptFrame
      .SourceItem = arrSlideID(slidecount)
      .Action = acOLECreateLink
   End With

   slideindex = slidecount

   Exit Sub

lastSlide_Click_Error:
   ErrHandler
   Exit Sub
End Sub