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