1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
|
Sub FindReplaceAll()
Dim sld As Slide
Dim shp As Shape
Dim ShpTxt As TextRange
Dim TmpTxt As TextRange
Dim FindWord As Variant
Dim ReplaceWord As Variant
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True
On Error Resume Next
FindWord = "United States"
ReplaceWord = InputBox("Saisir le mois de présentation du rapport")
'Loop through each slide in Presentation
For Each sld In PptApp.ActivePresentation.Slides
For Each shp In sld.Shapes
'Store shape text into a variable
Set ShpTxt = shp.TextFrame.TextRange
'Ensure There is Text To Search Through
If ShpTxt <> "" Then
'Store text into a variable
Set ShpTxt = shp.TextFrame.TextRange
'Find First Instance of "Find" word (if exists)
Set TmpTxt = ShpTxt.Replace( _
FindWhat:=FindWord, _
Replacewhat:=ReplaceWord, _
WholeWords:=True)
'Find Any Additional instances of "Find" word (if exists)
Do While Not TmpTxt Is Nothing
Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
Set TmpTxt = ShpTxt.Replace( _
FindWhat:=FindWord, _
Replacewhat:=ReplaceWord, _
WholeWords:=True)
Loop
End If
Next shp
Next sld
End Sub |
Partager