You are currently offline, waiting for your internet to reconnect

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

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 forApplications and with creating Microsoft Access applications using theprogramming tools provided with Microsoft Access. For more informationabout 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. Tomake sure the presentation is not left lingering in memory, be sure toclick the Quit PowerPoint button on the PowerPointDemo form. This removesthe 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
Properties

Article ID: 160822 - Last Review: 01/19/2007 20:50:55 - Revision: 4.4

  • Microsoft Access 95 Standard Edition
  • Microsoft Access 97 Standard Edition
  • Microsoft PowerPoint 95 Standard Edition
  • Microsoft PowerPoint 2000 Standard Edition
  • kbhowto kbinterop kbprogramming KB160822
Feedback