Article ID: 160822
Article Last Modified on 1/19/2007
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]
Dim ppObj As Object, ppPres As Object
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
149088 ACC: How to Display Microsoft PowerPoint Slides on a Form
Keywords: kbhowto kbinterop kbprogramming KB160822