Access Cookbook - Ken Getz [274]
Set db = CurrentDb( )
' Go get the text that applies to this slide.
Set rst = db.OpenRecordset("SELECT * FROM tblParagraphs " & _
"WHERE SlideNumber = " & intSlideNumber & _
" ORDER BY ObjectNumber, ParagraphNumber")
Call InsertText(rst, objSlide)
The next step is to insert the slides, text, indents, and bullets into the presentation. The InsertText procedure takes care of this task, given a reference to the recordset and to the slide. This code retrieves various fields from the recordset (which contains information for this one slide only), inserts the text it finds in the table into the shape, and then sets the indent level and bullet type based on information from the recordset:
Private Sub InsertText(rst As DAO.Recordset, sld As PowerPoint.Slide)
Dim pptShape As PowerPoint.Shape
Dim intParagraph As Integer
Do Until rst.EOF
' Insert all the paragraphs and indents, to get them right first.
' Then we'll go back and insert the formatting. This is required
' because of the way PowerPoint carries fonts forward from one
' paragraph to the next when inserting paragraphs.
Set pptShape = sld.Shapes(rst("ObjectNumber"))
pptShape.TextFrame.TextRange.InsertAfter rst("Text") & vbCrLf
With pptShape.TextFrame.TextRange. _
Paragraphs(rst("ParagraphNumber"))
If Not IsNull(rst("IndentLevel")) Then
.IndentLevel = rst("IndentLevel")
End If
.ParagraphFormat.Bullet.Type = rst("Bullet")
End With
rst.MoveNext
Loop
End Sub
Next, the code in CreateSlideText moves back to the beginning of the recordset and begins a loop that updates the formatting for each paragraph on the slide. For each row in the recordset, CreateSlideText retrieves a reference to the necessary slide object. Each object on the slide that can contain text is numbered, and the recordset contains an index (intObject) indicating which object you want to place your text into. If the value of the index in the recordset does not equal the current object index on the slide, the code retrieves a reference to the correct shape on the slide:
If intObject <> rst("ObjectNumber") Then
intObject = rst("ObjectNumber")
Set pptShape = objSlide.Shapes(intObject)
End If
The code then retrieves a reference to the correct paragraph so that it can work with the various properties of that paragraph:
Set pptTextRange = pptShape.TextFrame.TextRange. _
Paragraphs(rst("ParagraphNumber"))
Next, CreateSlideText sets the formatting properties corresponding to each field in tblParagraphs:
With pptTextRange.Font
If Not IsNull(rst("FontName")) Then
.Name = rst("FontName")
End If
If rst("FontSize") > 0 Then
.Size = rst("FontSize")
End If
If rst("Color") > 0 Then
.Color = rst("Color")
End If
' Set Yes/No/Use Default properties.
If rst("Shadow") <> conUseDefault Then
.Shadow = rst("Shadow")
End If
If rst("Bold") <> conUseDefault Then
.Bold = rst("Bold")
End If
If rst("Italic") <> conUseDefault Then
.Italic = rst("Italic")
End If
If rst("Underline") <> conUseDefault Then
.Underline = rst("Underline")
End If
End With
Once CreateSlideText has set all the necessary properties, it moves on to the next row. If at any point it encounters an error setting the properties of a given paragraph, it moves on to the next paragraph. (You might consider beefing up this error handling, but for the most part, it works fine.) Here, then, is the complete source for CreateSlideText:
Private Function CreateSlideText( _
objSlide As PowerPoint.Slide, intSlideNumber As Integer)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim pptShape As PowerPoint.Shape
Dim intObject As Integer
Dim intParagraph As Integer
Dim pptTextRange As PowerPoint.TextRange
Dim objFormat As PowerPoint.TextEffectFormat
Dim strFontName As String
Dim fnt As PowerPoint.Font
On Error GoTo HandleErrors
Set db = CurrentDb( )
' Go get the text that applies to this slide.
Set rst = db.OpenRecordset("SELECT * FROM tblParagraphs " & _
"WHERE SlideNumber = "