OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

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-2022, 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.


' --------------------------------------------------------------------------------

' Copyright ©1999-2022, 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 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' statement 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

 


 

 

Copyright 1999-2022 (c) Shyam Pillai. All rights reserved.