Sub drv()
Call pvtReplaceText("zzzzzzzz", "12345678", True)
End Sub
'http://skp.mvps.org/ppt00025.htm#2
Sub pvtReplaceText(sOld As String, sNew As String, Optional bWholeWord As Boolean = False)
Dim oSlide As Slide
Dim oShape As Shape
Dim oText As TextRange
Dim oTemp As TextRange
For Each oSlide In ActivePresentation.Slides
For Each oShape In oSlide.Shapes
Call pvtReplaceText1(oShape, sOld, sNew, bWholeWord)
Next oShape
Next oSlide
End Sub
Private Sub pvtReplaceText1(oShape As Object, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
Dim oText As TextRange
Dim oTemp As TextRange
Dim i As Long, iRows As Long, iCols As Integer
Dim oShapeTmp As Shape
Select Case oShape.Type
Case msoPlaceholder
Call pvtText(oShape, FindString, ReplaceString, bWholeWord)
If oShape.HasTable Then
Call pvtTable(oShape.Table, FindString, ReplaceString, bWholeWord)
End If
If oShape.HasSmartArt Then
Call pvtSmartArt(oShape.SmartArt, FindString, ReplaceString)
End If
Case msoTable
Call pvtTable(oShape.Table, FindString, ReplaceString, bWholeWord)
Case msoGroup 'Groups may contain shapes with text, so look within it
For i = 1 To oShape.GroupItems.Count
Call pvtReplaceText1(oShape.GroupItems(i), FindString, ReplaceString)
Next i
Case msoDiagram
Call pvtNodes(oShape.Diagram, FindString, ReplaceString)
Case msoSmartArt
Call pvtSmartArt(oShape.SmartArt, FindString, ReplaceString)
Case Else
Call pvtText(oShape, FindString, ReplaceString, bWholeWord)
End Select
End Sub
Private Sub pvtTable(oTable As Table, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
Dim iRows As Long, iCols As Integer
Dim oShapeTmp As Shape
With oTable
For iRows = 1 To .Rows.Count
For iCols = 1 To .Rows(iRows).Cells.Count
Set oShapeTmp = .Rows(iRows).Cells(iCols).Shape
Call pvtText(oShapeTmp, FindString, ReplaceString, bWholeWord)
Next
Next
End With
End Sub
Private Sub pvtText(oShape As Shape, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
Dim oTextRange As TextRange, oTextRangeTemp As TextRange
Dim i As Long
With oShape
If Not .HasTextFrame Then Exit Sub
If Not .TextFrame.HasText Then Exit Sub
Set oTextRange = .TextFrame.TextRange
Set oTextRangeTemp = oTextRange.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Do While Not oTextRangeTemp Is Nothing
Set oTextRangeTemp = oTextRange.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Loop
For i = 1 To oTextRange.Paragraphs.Count
Set oTextRange = oTextRange.Paragraphs(i)
oTextRange.Text = Trim(oTextRange.Text)
oTextRange.Characters(1, 1) = UCase(oTextRange.Characters(1, 1))
Next i
End With
End Sub
Private Sub pvtNodes(oDiagram As Diagram, FindString As String, ReplaceString As String)
Dim i As Long
With oDiagram
For i = 1 To .Nodes.Count
Call pvtText(.Nodes(i).TextShape, FindString, ReplaceString)
Next i
End With
End Sub
Private Sub pvtSmartArt(oSmartart As SmartArt, FindString As String, ReplaceString As String)
Dim i As Long
Dim s As String
With oSmartart
For i = 1 To .Nodes.Count
s = .AllNodes(i).TextFrame2.TextRange.Text
.AllNodes(i).TextFrame2.TextRange.Text = Replace(s, FindString, ReplaceString)
Next i
End With
End Sub