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
Tags: Powerpoint, Slide, UDF, TextRange, Replace, substitute
.com
Nenhum comentário:
Postar um comentário