Find & Replace du texte dans un tableau PPT

Bonjour à vous,

J'utilise une macro qui cherche du texte et le remplace dans un fichier ppt : cela me permet de créer des documents ppt personnalisés rapidement.
Ces derniers jours, j'ai essayé de rajouter des tableaux dans mon ppt et j'ai découvert que ma sub ne va pas dans les cellules de mon tableau pour trouver et remplacer le texte.

En fait ma Sub va dans les slides, puis dans les shapes, puis dans les textframes et cherche le texte pour le remplacer si besoin.

Je souhaiterais que ma sub aille également dans les tableaux en plus des textframes mais je ne sais pas comment faire !
merci beaucoup par avance à ceux qui m'aideront !

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

Sub Switch(pptDoc As PowerPoint.Presentation, FindString As String, ReplaceString As Variant) With pptDoc For Each oSld In .Slides For Each oShp In oSld.Shapes If oShp.HasTextFrame Then If oShp.TextFrame.HasText Then Set oTxtRng = oShp.TextFrame.TextRange Set oTxtFnd = oTxtRng.Find(FindWhat:=FindString)   Do While Not oTxtFnd Is Nothing Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, After:=0, MatchCase:=True, WholeWords:=False) Set oTxtFnd = oTxtRng.Find(FindWhat:=FindString) Loop   Else: Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, After:=0, MatchCase:=True, WholeWords:=False) Do While Not oTmpRng Is Nothing Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, After:=0, MatchCase:=True, WholeWords:=False) Loop   End If End If Next oShp Next oSld End With End Sub

---

Bonjour,

A tester, cette version plus complète:

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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71

'--- https://stackoverflow.com/questions/18062066/how-to-modify-text-in-powerpoint-via-excel-vba-without-changing-style   Sub Replace_in_Shapes_and_Tables(pPPTFile As Presentation, sFromStr As String, sToStr As String) Dim sld As Slide Dim shp As Shape Dim i As Long Dim j As Long Dim m As Long Dim trFoundText As TextRange   For Each sld In pPPTFile.Slides For Each shp In sld.Shapes   If shp.HasTextFrame Then If shp.TextFrame.HasText Then ' only perform action on shape if it contains the target string Set trFoundText = shp.TextFrame.TextRange.Find(sFromStr) If Not (trFoundText Is Nothing) Then m = shp.TextFrame.TextRange.Find(sFromStr).Characters.Start shp.TextFrame.TextRange.Characters(m).InsertBefore (sToStr) shp.TextFrame.TextRange.Find(sFromStr).Delete End If End If End If   If shp.HasTable Then For i = 1 To shp.Table.Rows.Count For j = 1 To shp.Table.Columns.Count   Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr) If Not (trFoundText Is Nothing) Then m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Characters.Start shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (sToStr) shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Delete End If   Next j Next i End If   Next shp Next sld   For Each shp In pPPTFile.SlideMaster.Shapes If shp.HasTextFrame Then If shp.TextFrame.HasText Then Set trFoundText = shp.TextFrame.TextRange.Find(sFromStr) If Not (trFoundText Is Nothing) Then m = shp.TextFrame.TextRange.Find(sFromStr).Characters.Start shp.TextFrame.TextRange.Characters(m).InsertBefore (sToStr) shp.TextFrame.TextRange.Find(sFromStr).Delete End If   End If End If   If shp.HasTable Then For i = 1 To shp.Table.Rows.Count For j = 1 To shp.Table.Columns.Count Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr) If Not (trFoundText Is Nothing) Then m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Characters.Start shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (sToStr) shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Delete End If   Next j Next i End If Next shp   End Sub

---

Cordialement.