Use CreateObject to Print Slides From A Presentation

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-2007, 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<>"" .

Top

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, 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' 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 oShpTmp = oShp.Table.Rows(iRows).Cells(icol).Shape
            Call ReplaceText(oShpTmp, FindString, ReplaceString)
        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