[ Team LiB ] |
Recipe 12.7 Create a PowerPoint Presentation from Access Data12.7.1 ProblemYou need to create similar Microsoft PowerPoint presentations over and over. You currently take an existing presentation, copy it to a new location, and modify it as necessary, resulting in a number of copies of the same text littering your hard disk. It seems that you could just store all the text and its formatting information in an Access table and then create the presentation programmatically when necessary. Then, you could choose just the slides you need, make modifications as necessary, and have only one place where you store the data. Is this possible? 12.7.2 SolutionMicrosoft PowerPoint (part of Microsoft Office) offers an amazingly rich set of objects, methods, and properties. Even though it's not a developer's tool, its object model is spectacularly deep, especially in comparison to Access's. It appears that you can do anything programmatically from an Automation client (such as Access) that you can do manually, using PowerPoint as an Automation server—so the answer to the original question is "Yes!" You can definitely create presentations programmatically from Access using tables to store all the information about your presentation. This solution involves two major activities: setting up the data in tables and using the interface to create your presentation. This section demonstrates both activities. To try out the sample application, load and run frmPowerPoint from 12-07.MDB. First choose a template from the combo box's list of templates; then enter a filename to which to save your presentation (click on the "..." button to use the common File Open/Save dialog). Click the Create Presentation button to start PowerPoint and create the presentation. Figure 12-12 shows the sample form in action. Figure 12-12. Use frmPowerPoint to create PowerPoint presentations from within AccessTo use this technique to create your own presentations, follow these steps:
Figure 12-13. Use the Tools > References... dialog to add library references
Figure 12-14. Use zfrmSlides to add new slides to your presentation
Figure 12-15. Use zsfrmParagraphs to add or edit paragraph text and properties
12.7.3 DiscussionCreating the presentation boils down to four basic steps:
You'll find all the necessary code in basPowerPoint in 12-07.MDB. The following sections describe in detail how these steps work. 12.7.3.1 Starting and stopping PowerPointTo create the presentation, you must first retrieve a reference to the PowerPoint Application object. If PowerPoint is already running, the GetObject function will be able to retrieve the object reference. If not, the code will jump to an error handler, which will try the CreateObject method. Once the procedure has created and saved the slide presentation, if the code started PowerPoint, it will try to close PowerPoint; if not, it will leave the application running. The following skeleton version of the CreatePresentation function (shown later in its entirety) handles the application startup and shutdown: Public Function CreatePresentation(blnShowIt As Boolean, _ ByVal varTemplate As Variant, varFileName As Variant) Dim app As PowerPoint.Application Dim blnAlreadyRunning As Boolean On Error GoTo HandleErrors ' Assume that PowerPoint was already running. blnAlreadyRunning = True Set app = GetObject(, "PowerPoint.Application") ' Do the work, creating the presentation. 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 ' Handle other errors... End Select Resume ExitHere End Function 12.7.3.2 Creating the presentationTo create the presentation, you must add a new presentation to the application's collection of open presentations. To add a new item to the collection, use the Add method of the Presentations collection of the Application object: ' Get a reference to that new presentation. Set pptPresentation = app.Presentations.Add(WithWindow:=False)
Once you've created the presentation, the code uses the ApplyTemplate method of the new Presentation object, given the name of the template you've chosen from frmPowerPoint: If Len(varTemplate & "") > 0 Then pptPresentation.ApplyTemplate varTemplate End If The code then calls the user-defined CreateSlides function, passing to it the new Presentation object, to create all the slides for the presentation. This section and the previous one draw their code from the CreatePresentation function in basPowerPoint. Here's the function in its entirety: Public Function CreatePresentation(blnShowIt As Boolean, _ ByVal varTemplate As Variant, varFileName As Variant) ' Highest-level routine. Actually create the ' presentation, and set up the slides. Dim pptPresentation As PowerPoint.Presentation Dim lngResult As Long Dim app As PowerPoint.Application Dim blnAlreadyRunning As Boolean On Error GoTo HandleErrors ' Assume that PowerPoint was already running. blnAlreadyRunning = True Set app = GetObject(, "PowerPoint.Application") ' If the caller wants to see this happening, make the ' application window visible and set the focus there. If blnShowIt Then app.Visible = True AppActivate "Microsoft PowerPoint" End If ' Get a reference to that new presentation. 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 12.7.3.3 Creating each slideOnce 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 12.7.3.4 Creating the textCreating the slide text can be broken down into these small steps:
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. Given that index, CreateSlideText can request just the paragraphs associated with that slide from tblParagraphs: 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 = " & intSlideNumber & _ " ORDER BY ObjectNumber, ParagraphNumber") ' Now walk through the list of text items, sticking ' them into the objects and applying properties. Call InsertText(rst, objSlide) rst.MoveFirst Do Until rst.EOF ' Update the status information on the form. With Forms("frmPowerPoint") .UpdateDisplay rst("SlideNumber"), rst("Text") .Repaint End With ' No need to grab a reference to the shape each ' time through. Cache this value for later use. If intObject <> rst("ObjectNumber") Then intObject = rst("ObjectNumber") Set pptShape = objSlide.Shapes(intObject) End If ' Get a reference to the paragraph in question, ' then set its paragraph properties. Set pptTextRange = pptShape.TextFrame.TextRange. _ Paragraphs(rst("ParagraphNumber")) 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 CreateSlideTextNext: rst.MoveNext Loop CreateSlideText = True ExitHere: On Error Resume Next rst.Close Set rst = Nothing Set db = Nothing Exit Function HandleErrors: CreateSlideText = False Select Case Err.Number Case conErrInvalidObjectIndex Resume CreateSlideTextNext Case Else MsgBox "Error: " & Err.Description & " (" & Err.Number & ")",_ vbExclamation, "Create Slides Text" End Select Resume ExitHere End Function 12.7.4 CommentsThis solution uses only a small subset of the PowerPoint Automation interface. A great deal more functionality is available to you if you dig deep enough to find it. For example, you might want to support more of the text or bullet attributes than we've chosen, or dig into slide transitions, builds, and animation. Use the Object Browser (press F2 in a module window), shown in Figure 12-16, to help dig through the PowerPoint object model. You can work your way down through the hierarchy in an orderly fashion. For example, find the Application object in the left window, then browse through the right window until you find the Presentations collection. On the left, find the Presentations collection, and on the right, find the Add method. That's how we wrote this solution: by digging through the various objects, collections, methods, and properties that the Object Browser displays. Figure 12-16. The Object Browser makes it possible to dig around in object modelsYou may also want to look at basGetTemplate, which includes a substantial amount of code dedicated to retrieving a list of all of PowerPoint's design templates. As it's installed, PowerPoint places the location of these templates in your registry. Two interesting issues are involved here: finding the name of the directory where the templates have been installed, and creating an array containing the names of the templates. Once the code creates the array, it uses the standard list-filling callback function mechanism, described in Chapter 7, to populate the combo box on the sample form. Though these topics are beyond the scope of this solution, you may find it useful to dig into the code, which has comments to help you through it. |
[ Team LiB ] |