Sub FindPpt()
Dim reponse$
Dim SLD As Slide
Dim SH As Shape
Dim TR As TextRange
Dim TR2 As TextRange 'Range du texte trouvé
reponse$ = InputBox("Texte à rechercher")
If reponse$ = "" Then Exit Sub
For Each SLD In Application.ActivePresentation.Slides
For Each SH In SLD.Shapes
If SH.HasTextFrame Then
Set TR = SH.TextFrame.TextRange
Set TR2 = TR.Find(FindWhat:=reponse$, _
MatchCase:=msoFalse, _
wholewords:=msoFalse)
Do Until TR2 Is Nothing
SLD.Select
With TR2
.Select
MsgBox "Appuyez sur Ok pour continuer"
Set TR2 = TR.Find(FindWhat:=reponse$, _
MatchCase:=msoFalse, _
wholewords:=msoFalse, _
After:=.Start + .Length - 1)
End With
Loop
End If
Next SH
Next SLD
End Sub