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

End Sub

Referência: Shyam Pillai, Joe Stern

Tags: Powerpoint, Slide, UDF, TextRange, Replace, substitute

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA Blogs

  

  

bernardes@.com