Access Cookbook - Ken Getz [273]
Set pptPresentation = app.Presentations.Add(WithWindow:=False)
If Len(varTemplate & "") > 0 Then
pptPresentation.ApplyTemplate varTemplate
End If
lngResult = CreateSlides(pptPresentation)
pptPresentation.SaveAs FileName:=varFileName
If Not blnAlreadyRunning Then
app.Quit
End If
Set app = Nothing
ExitHere:
Exit Function
HandleErrors:
Select Case Err.Number
Case conErrCantStart
Set app = New PowerPoint.Application
blnAlreadyRunning = False
Resume Next
Case conErrFileInUse
MsgBox "The output file name is in use." & vbCrLf & _
"Switch to PowerPoint and save the file manually.", _
vbExclamation, "Create Presentation"
Case Else
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")", _
vbExclamation, "Create Presentation"
End Select
Resume ExitHere
End Function
Creating each slide
Once you've created the presentation, the next step is to loop through all the rows in tblSlides, creating the slide described by each row. The code in CreateSlides, shown next, does the work. It boils down to a single line of code: you must call the Add method of the Slides collection for the current presentation to add each slide:
Set objSlide = obj.Slides.Add(intCount, rstSlides("SlideLayout"))
As you can see, you must provide the Add method with the index of the slide you're creating and the layout type for the slide. (See the table tlkpLayouts for all the possible layouts and the associated enumerated value for each.) The CreateSlides function walks through tblSlides one row at a time, creating the slide and calling the user-defined CreateSlideText function for each slide whose Include flag is set to True.
The complete source code for the CreateSlides function is:
Private Function CreateSlides(obj As Presentation)
' obj is the PowerPoint presentation object.
' It contains slide objects.
Const acbcDataSource = "qrySlideInfo"
Dim rstSlides As DAO.Recordset
Dim db As DAO.Database
Dim objSlide As PowerPoint.Slide
Dim intSlide As Integer
Dim intObject As Integer
Dim intParagraph As Integer
Dim intCount As Integer
Dim strText As String
Dim blnDone As Boolean
On Error GoTo HandleErrors
Set db = CurrentDb( )
Set rstSlides = db.OpenRecordset( _
"Select * from tblSlides Where Include Order By SlideNumber")
blnDone = False
Do While Not rstSlides.EOF And Not blnDone
If rstSlides("Include") Then
intCount = intCount + 1
' Add the next slide.
Set objSlide = obj.Slides. _
Add(intCount, rstSlides("SlideLayout"))
If Not CreateSlideText( _
objSlide, rstSlides("SlideNumber")) Then
blnDone = True
End If
End If
rstSlides.MoveNext
Loop
ExitHere:
If Not rstSlides Is Nothing Then
rstSlides.Close
End If
Exit Function
HandleErrors:
Select Case Err.Number
Case Else
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")", _
vbExclamation, "Create Slides"
End Select
Resume ExitHere
End Function
Creating the text
Creating the slide text can be broken down into these small steps:
Retrieve the list of pertinent paragraphs from tblParagraphs.
Loop through all the rows, adding a paragraph to the specified object for each.
Loop through the rows again, setting the formatting for each paragraph.
TIP
Why loop through the rows for each slide twice? Because of the way PowerPoint handles inserted text, you must first insert the rows, and then go back and format those rows. Otherwise, each new paragraph will "inherit" the formatting of the previous paragraph. To work around this in the simplest manner possible, the code inserts each of the paragraphs and sets the indent and bullet, then makes a second pass through the paragraphs and sets the necessary formatting. Although this may take a bit longer, it simplifies the code.
The following paragraphs describe each step from the CreateSlideText function, which is shown in its entirety later in this section.
To retrieve the list of paragraphs that apply to the current slide, CreateSlides passes the slide object and its index as arguments to CreateSlideText.