How to create a PowerPoint presentation by using Visual Basic for Applications code in Access (160822)


The information in this article applies to:

  • Microsoft Access for Windows 95 7.0
  • Microsoft Access 97
  • Microsoft PowerPoint for Windows 95
  • Microsoft PowerPoint 2000
This article was previously published under Q160822

SUMMARY

Advanced: Requires expert coding, interoperability, and multiuser skills.

This article shows you how to create sample Microsoft Visual Basic for Applications code in Microsoft Access that uses Automation to create a Microsoft PowerPoint presentation.

This article assumes that you are familiar with Visual Basic for Applications and with creating Microsoft Access applications using the programming tools provided with Microsoft Access. For more information about Visual Basic for Applications, please refer to your version of the "Building Applications with Microsoft Access" manual.

MORE INFORMATION

  1. Start Microsoft Access and open the sample database Northwind.mdb.
  2. Create the following new form not based on any table or query in Design view: 
          Form: PowerPointDemo
      ------------------------------
      Caption: PowerPoint Demo

      Command Button:
         Name: cmdPowerPoint
         Caption: PowerPoint Example
         Width: 2"
         OnClick: [Event Procedure]
      Command Button:
         Name: cmdQuit
         Caption: Quit PowerPoint
         Width: 2"
         OnClick: [Event Procedure]
  3. On the View menu, click Code.
  4. On the Tools menu, click References.
  5. If you have Microsoft PowerPoint 97, click Microsoft PowerPoint 8.0 Object Library in the Available References box. If that reference does not appear, click the Browse button and browse for MSPPT8.OLB, which is installed by default in the C:\Program Files\Microsoft Office\Office folder.

    If you have Microsoft PowerPoint 7.0, click PowerPoint 7.0 Object Library in the Available References box. If that reference does not appear, click the Browse button and browse for Powerpnt.tlb, which is installed by default in the C:\Office\Powerpnt folder.
  6. Click OK to close the References dialog box.
  7. Type the following line in the Declarations section of the PowerPointDemo form's class module: 
           Dim ppObj As Object, ppPres As Object
  8. Type the following procedures.

    For Microsoft PowerPoint 97: 
          Private Sub cmdPowerPoint_Click()
        Dim xloop As Integer
        On Error Resume Next
        Set ppObj = GetObject(, "PowerPoint.application")
        If Err.Number Then
           Set ppObj = CreateObject("PowerPoint.Application")
           Err.Clear
        End If
        On Error GoTo err_cmdOLEPowerPoint
        Set ppPres = ppObj.Presentations.Add

        With ppPres
           For xloop = 1 To 5
              .Slides.Add xloop, ppLayoutTitle
              .SlideMaster.Background.Fill.PresetTextured _
                 msoTextureOak
              .Slides(xloop).Shapes(1).TextFrame.TextRange.Text = _
                 "Hi!  Page " & xloop
              .Slides(xloop).SlideShowTransition.EntryEffect = ppEffectFade

              Select Case xloop
                 Case 1
                    With .Slides(xloop).Shapes(2).TextFrame.TextRange
                       .Text = "This is an Example of Automation."
                       .Characters.Font.Color.RGB = RGB(255, 255, 255)
                       .Characters.Font.Shadow = True
                    End With
                    .Slides(xloop).Shapes(1).TextFrame.TextRange. _
                       Characters.Font.Size = 50

                 Case 2
                    With .Slides(xloop).Shapes(2).TextFrame.TextRange
                       .Text = "The programs interact seamlessly..."
                       .Characters.Font.Color.RGB = RGB(255, 0, 255)
                       .Characters.Font.Size = 48
                       .Characters.Font.Shadow = True
                    End With
                    .Slides(xloop).Shapes(1).TextFrame.TextRange. _
                       Characters.Font.Size = 90

                 Case 3
                    With .Slides(xloop).Shapes(2).TextFrame.TextRange
                       .Text = "Demonstrating the power..."
                       .Characters.Font.Color.RGB = RGB(255, 0, 0)
                       .Characters.Font.Size = 42
                       .Characters.Font.Shadow = True
                    End With
                    .Slides(xloop).Shapes(1).TextFrame.TextRange. _
                       Characters.Font.Size = 50

                 Case 4
                    With .Slides(xloop).Shapes(2).TextFrame.TextRange
                       .Text = "Of interoperable applications..."
                       .Characters.Font.Color.RGB = RGB(0, 0, 255)
                       .Characters.Font.Size = 34
                       .Characters.Font.Shadow = True
                    End With
                    .Slides(xloop).Shapes(1).TextFrame.TextRange. _
                       Characters.Font.Size = 100

                 Case 5
                    With .Slides(xloop).Shapes(2).TextFrame.TextRange
                       .Text = "Created on the Fly!!!!"
                       .Characters.Font.Color.RGB = RGB(0, 255, 0)
                       .Characters.Font.Size = 72
                       .Characters.Font.Shadow = True
                    End With
                    .Slides(xloop).Shapes(1).TextFrame.TextRange. _
                       Characters.Font.Size = 60

              End Select
           Next
        End With
        ppPres.SlideShowSettings.Run
        Exit Sub
        err_cmdOLEPowerPoint:
        MsgBox Err.Number & " " & Err.Description
      End Sub

      Private Sub cmdQuit_Click()
         ppPres.Close
         Set ppPres = Nothing
         ppObj.Quit
         Set ppObj = Nothing
         MsgBox "Action Complete"
      End Sub
    For Microsoft PowerPoint 7.0: 
          Private Sub cmdPowerPoint_Click()
        Dim xloop As Integer
        On Error Resume Next
        Set ppObj = GetObject(, "PowerPoint.application")
        If Err.Number Then
           Set ppObj = CreateObject("PowerPoint.Application")
           Err.Clear
        End If
        On Error GoTo err_cmdOLEPowerPoint
        Set ppPres = ppObj.Presentations.Add

        With ppPres
           For xloop = 1 To 5
              .Slides.Add xloop, ppLayoutTitle
              .SlideMaster.Background.Fill.PresetTextured _
                 ppPresetTextureOak
              .Slides(xloop).Objects(1).Text = "Hi!  Page " & xloop
              .Slides(xloop).SlideShowEffects.EntryEffect = ppEffectFade

              Select Case xloop
                 Case 1
                    .Slides(xloop).Objects(2).Text = _
                       "This is an Example of Automation."
                    .Slides(xloop).Objects(2).Text.CharFormat.Color.RGB = _
                       RGB(255, 255, 255)
                    .Slides(xloop).Objects(2).Text.CharFormat.Shadow = _
                       True
                    .Slides(xloop).Objects(1).Text.CharFormat.Points = 50

                 Case 2
                    .Slides(xloop).Objects(2).Text = _
                       "The programs interact seamlessly..."
                    .Slides(xloop).Objects(2).Text.CharFormat.Color.RGB = _
                       RGB(255, 0, 255)
                    .Slides(xloop).Objects(2).Text.CharFormat.Points = 48
                    .Slides(xloop).Objects(2).Text.CharFormat.Shadow = _
                       True
                    .Slides(xloop).Objects(1).Text.CharFormat.Points = 90

                 Case 3
                    .Slides(xloop).Objects(2).Text = _
                       "Demonstrating the power..."
                    .Slides(xloop).Objects(2).Text.CharFormat.Color.RGB = _
                       RGB(255, 0, 0)
                    .Slides(xloop).Objects(2).Text.CharFormat.Points = 42
                    .Slides(xloop).Objects(2).Text.CharFormat.Shadow = _
                       True
                    .Slides(xloop).Objects(1).Text.CharFormat.Points = 50

                 Case 4
                    .Slides(xloop).Objects(2).Text = _
                       "Of interoperable applications..."
                    .Slides(xloop).Objects(2).Text.CharFormat.Color.RGB = _
                       RGB(0, 0, 255)
                    .Slides(xloop).Objects(2).Text.CharFormat.Points = 34
                    .Slides(xloop).Objects(2).Text.CharFormat.Shadow = _
                       True
                    .Slides(xloop).Objects(1).Text.CharFormat.Points = 100

                 Case 5
                    .Slides(xloop).Objects(2).Text = _
                       "Created on the Fly!!!!"
                    .Slides(xloop).Objects(2).Text.CharFormat.Color.RGB = _
                       RGB(0, 255, 0)
                    .Slides(xloop).Objects(2).Text.CharFormat.Points = 72
                    .Slides(xloop).Objects(2).Text.CharFormat.Shadow = _
                       True
                    .Slides(xloop).Objects(1).Text.CharFormat.Points = 60

              End Select
           Next
        End With
        ppPres.SlideShow.Run ppSlideShowFullScreen
        Exit Sub
        err_cmdOLEPowerPoint:
        MsgBox Err.Number & " " & Err.Description
      End Sub

      Private Sub cmdQuit_Click()
         ppPres.Delete
         Set ppPres = Nothing
         ppObj.Quit
         Set ppObj = Nothing
         MsgBox "Action Complete"
      End Sub
  9. Save the PowerPointDemo form and open it in Form view. Click the
command button. Note that the PowerPoint slide show is created and displayed on your screen.

NOTE: Although the presentation ends, it is not removed from memory. To make sure the presentation is not left lingering in memory, be sure to click the Quit PowerPoint button on the PowerPointDemo form. This removes the PowerPoint object variables from memory.

REFERENCES

For more information about using Automation with Microsoft PowerPoint, please see the following article in the Microsoft Knowledge Base:

149088 ACC: How to Display Microsoft PowerPoint Slides on a Form

Modification Type:MinorLast Reviewed:10/11/2006
Keywords:kbhowto kbinterop kbProgramming KB160822
©2004 Microsoft Corporation. All rights reserved.