ID: Q160822
The information in this article applies to:
Advanced: Requires expert coding, interoperability, and multiuser skills.
This article shows you how to create sample Visual Basic for Applications code 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.
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]
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.
7. Type the following line in the Declarations section of the
PowerPointDemo form's class module:
Dim ppObj As Object, ppPres As Object
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
button. Note that the PowerPoint slide show is created and displayed on
your screen.
For more information about using Automation with Microsoft PowerPoint, please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q149088
TITLE : ACC: How to Display Microsoft PowerPoint Slides on a Form
Keywords : kbinterop IntpOlea
Version : 7.0 97
Platform : WINDOWS
Hardware : x86
Issue type : kbhowtoLast Reviewed: November 21, 1998