Views

Histats

Vitrine

VBA Powerpoint - Localize e substitua códigos no MS PowerPoint - Global Find And Replace routine in PowerPoint


powerpoint-header.jpg

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ênciaShyam Pillai, Joe Stern

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

André Luiz Bernardes
A&A® - Work smart, not hard.





✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias