Use CreateObject to Print Slides From A Presentation / Global Find And Replace routine in PowerPoint

Using the Shell call to the print a PowerPoint Presentation using the /P parameter is an alternative. However you might want to print specific slides (not tackled in this example) which cannot be achieved using the Shell call. This example uses the CreateObject call to create an instance of PowerPoint, Open the file and then Print it. This can be used from any VB/VBA app to print a presentation.

' --------------------------------------------------------------------------------
' Copyright ©1999-2011, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub PrintPPT()
    Dim AppPPT As Object
    Set AppPPT = CreateObject("PowerPoint.Application")
    AppPPT.Visible = True
   ' If you want to hide the PowerPoint Window, set the visible property
    ' to FALSE and WithWindow argument of Open method to FALSE too.
    With AppPPT.Presentations.Open("c:\sample.ppt")
        DoEvents
   ' Use .PrintOptions property to specify any additional settings
    ' Set background printing off else, PowerPoint will terminate
    ' before printing is completed.
        .PrintOptions.PrintInBackground = False
        .PrintOut
        .PrintOptions.PrintInBackground = True
    End With
    AppPPT.Quit
    Set AppPPT = Nothing
End Sub

Global Find And Replace routine in PowerPoint

Let's take a look at how to make use of the Replace method of the TextRange object in PowerPoint to create a global find and replace routine which replaces the text across all open presentations.

Thanks to Joe Stern who noted that I hadn't included code to support tables.

Note: PowerPoint 2007 object model has broken this line - Do While Not oTmpRng Is Nothing. If you are using PPT 2007 change this line to Do While oTmpRng.Text<>"" .

Also, note that for PPT 2007, you should check the ContainedType property to determine the content within the Placeholder shape and process it accordingly.

Top

Sub GlobalFindAndReplace()
Dim oPres As Presentation
Dim oSld As Slide
Dim oShp As Shape
Dim FindWhat As String
Dim ReplaceWith As String

FindWhat = "Like"
ReplaceWith = "Not Like"
For Each oPres In Application.Presentations
     For Each oSld In oPres.Slides
        For Each oShp In oSld.Shapes
            Call ReplaceText(oShp, FindWhat, ReplaceWith)
        Next oShp
    Next oSld
Next oPres
End Sub

Sub ReplaceText(oShp As Object, FindString As String, ReplaceString As String)
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Dim I As Integer
Dim iRows As Integer
Dim iCols As Integer
Dim oShpTmp As Shape

' Always include the 'On error resume next' statememt below when you are working with text range object.
' I know of at least one PowerPoint bug where it will error out - when an image has been dragged/pasted
' into a text box. In such a case, both HasTextFrame and HasText properties will return TRUE but PowerPoint
' will throw an error when you try to retrieve the text.
On Error Resume Next
Select Case oShp.Type
Case 19 'msoTable
    For iRows = 1 To oShp.Table.Rows.Count
        For icol = 1 To oShp.Table.Rows(iRows).Cells.Count
            Set oTxtRng = oShp.Table.Rows(iRows).Cells(iCol).Shape.TextFrame.TextRange
            Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, WholeWords:=True)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=True)
Loop
        Next
    Next
Case msoGroup 'Groups may contain shapes with text, so look within it
    For I = 1 To oShp.GroupItems.Count
        Call ReplaceText(oShp.GroupItems(I), FindString, ReplaceString)
    Next I
Case 21 ' msoDiagram
    For I = 1 To oShp.Diagram.Nodes.Count
        Call ReplaceText(oShp.Diagram.Nodes(I).TextShape, FindString,     ReplaceString)
    Next I
Case Else
    If oShp.HasTextFrame Then
        If oShp.TextFrame.HasText Then
            Set oTxtRng = oShp.TextFrame.TextRange
            Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
                Replacewhat:=ReplaceString, WholeWords:=True)
            Do While Not oTmpRng Is Nothing
                Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
                            Replacewhat:=ReplaceString, _
                            After:=oTmpRng.Start + oTmpRng.Length, _
                            WholeWords:=True)
            Loop
       End If
    End If
End Select
End Sub

Top