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
| ' parcourt la prés pour lire toutes les TextRanges
Sub compteur()
Dim D As Slide, Sh As Shape
Dim nb As Integer
' ActivePresentation peut bien sûr être remplacé par un paramètre
For Each D In ActivePresentation.Slides
For Each Sh In D.Shapes
If Sh.HasTextFrame Then
nb = nb + CompterMots(Sh.TextFrame.TextRange)
End If
Next
Next
MsgBox nb & " mots"
End Sub
' compte le nb de mots dans un texte
Function CompterMots(txt As String) As Integer
Dim Rx As New RegExp, txt2 As String
If txt = "" Then Exit Function
' la Pattern peut être modifiée selon la définition d'un "mot"
Rx.Pattern = "[\s,;.:!??
+-/*()«»@-]+"
Rx.Global = True
txt2 = Rx.Replace(txt, " ")
txt2 = Trim(txt2)
CompterMots = UBound(Split(txt2, " ")) + 1
End Function |
Partager