Discussion :

[tarabistouille]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Horacion]

Salut,
Il est possible que ton objet Shape ne soit pas du texte (une flèche par exemple), ainsi tu ne peux pas rechercher un mot dans cet objet.
Essaye ça, si ça fonctionne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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