✔ Programação GLOBAL®: VBA Powerpoint - Localize e substitua códigos no MS PowerPoint - Global Find And Replace routine in PowerPoint

Vamos dar uma olhada em como fazer uso do método Replace do objeto TextRange no MS PowerPoint para criar uma funcionalidade de localizar e substituir a nível global, substituindo o texto em todas as apresentações abertas.

Nota: O modelo de objeto do PowerPoint 2007 quebra a linha - Do While Not oTmpRng. Se estiver usando mudança PPT 2007, a linha será Do While oTmpRng.Text <> "".

Além disso, observe que para 2007 PPT, você deve verificar a propriedade ContainedType para determinar o conteúdo dentro da forma de espaço reservado e processá-lo em conformidade.

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