[PPT-2007] Création d'une macro pour rechercher et remplacer un mot dans toute la présentation

Bonjour à tous,

J'essaie de développer un bout de code qui me permettrait de remplacer dans une présentation powerpoint, un mot par un autre dans tout le document (composé d'environ 50 slides)

J'ai trouvé une macro déjà existante sur internet mais en l'essayant, elle me renvoie une erreur d'execution 13: Incompatibilité de type (ligne en rouge dans le code ci-dessous avec le debogueur)...

Si quelqu'un pouvait m'aiguiller sur la raison de cette erreur, je lui en serai extremement reconnaissant!

Code:

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
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

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

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