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
|