Parcourir zones de texte d'un PPT et rechercher un texte

Bonjour,

Je cherche à parcourir toutes les zones de texte dans un PPT, et surtout dans chacune d'elle rechercher un texte donné.

J'ai codé ceci:

Sub vérifier_présence()

Set appPPoint = New PowerPoint.Application

Dim Presentation As PowerPoint.Presentation

Application.ScreenUpdating = False

chemin_final = "C:\Documents and Settings\K007881\Desktop\Présentation1.ppt"

k = 0

Set Presentation = appPPoint.Presentations.Open(chemin_final, withWindow:=msoFalse)

For Each diapo In Presentation.Slides

For Each Forme In diapo.Shapes

If Find("lol", Forme.TextFrame.TextRange) Then

k = k + 1

End If

Next

Next

Presentation.Close

appPPoint.Quit

Application.ScreenUpdating = True

End Sub

Ici, je cherche le texte "lol" dans toutes les formes données. Je sais déjà que ce code permet effectivement de parcourir toutes les zones de texte du fichier PPT. Mais je ne sais pas quoi ecrire pour la fonction find (oui, je sais qu'écrit comme ça, elle ne donnera rien). Chaque syntaxe que je tente renvois "erreure, sub non définie".

Le but final sera:

Rechercher un texte donné (mettons "lol") dans toutes les zones de texte du document. Si on trouve le texte "lol", vérifier si on ne trouve pas les caractères " (x" juste après. Si c'est le cas, prendre les charactères suivants jusqu'au charactère ")" (c'est à dire que si on trouve "lol", on regarde si on n'a pas "lol (x5)" par exemple, auquel cas on récupère le 5, et on compte k=k+5 au lieux de k=k+1).

C'est la première fois que j'essais de travailelr sur un PPT depuis excel VBA et je galère, mais le gros point dur pour moi c'est rechercher un texte dans une zone de texte ppt... Bref, si vous voyez comment faire, je suis preneur !!

Merci

Bonsoir,

une proposition de solution pour remplacer ton find

For Each Forme In diapo.Shapes
q = InStr(Forme.TextFrame.TextRange, "lol")
While q > 0
k = k + 1
q = InStr(q + 1, Forme.TextFrame.TextRange, "lol")
Wend
Next

Bonjour h2so4,

Ton code ne compte pas les "lol" perdu au milieux d'autres caractères, comme:

"fds456gsd

Lol 846ghkhg"

ou

"Fdgfd

Lol

fdh456hd"

C'est ce que je voudrai arriver à faire

Le soucis apparement, c'est qu'instr ne cherche pas plus loin que le premier caractère "alt+entré", qui correspond à un saut de ligne...

edit: après test, c'est pas un char(10) qui fait la séparation entre mes lignes ... je pensais faire un split et rechercher dans toutes les parties mais il n'y à pas de char(10)... d'ailleurs si je colle un texte de 2 lignes vers une cellule, j'obtient chaque ligne dans une cellule

J'avance un peu:

J'arrive à trouver tous les "lol", quel que soit leur position. J'arrive aussi à trouver les "lol (x".

Il ne me reste plus qu'a arriver à lire le nombre qui se trouve juste après (et fini à la prochaine ")" ).

C'est maintenant là que je bloque.

Voici le code:

Sub vérifier_présence()

Set appPPoint = New PowerPoint.Application

Dim Presentation As PowerPoint.Presentation

Application.ScreenUpdating = False

chemin_final = "C:\Documents and Settings\K007881\Desktop\Présentation1.ppt"

k = 0

Set Presentation = appPPoint.Presentations.Open(chemin_final, withWindow:=msoFalse)

For Each diapo In Presentation.Slides

For Each Forme In diapo.Shapes

Set TR = Forme.TextFrame.TextRange.Find(FindWhat:="lol", MatchCase:=msoFalse, wholewords:=msoFalse)

If Not TR Is Nothing Then

Set TR2 = Forme.TextFrame.TextRange.Find(FindWhat:="lol (x", MatchCase:=msoFalse, wholewords:=msoFalse)

If Not TR2 Is Nothing Then

"ici il faudrait pouvoir compter le nombre après "lol (x" ... End If

End If

Next

Next

Presentation.Close

appPPoint.Quit

MsgBox k

Application.ScreenUpdating = True

End Sub

Voici le code qui me permet d'obtenir ce que je voulais:

Sub vérifier_présence()

Set appPPoint = New PowerPoint.Application

Dim Presentation As PowerPoint.Presentation

Application.ScreenUpdating = False

chemin_final = "C:\Documents and Settings\K007881\Desktop\Présentation1.ppt"

Set Presentation = appPPoint.Presentations.Open(chemin_final, withWindow:=msoFalse)

For i = 3 To Range("A" & Rows.Count).End(xlUp).Row

k = 0

textecherché = ThisWorkbook.Sheets(1).Cells(i, 1).Value

For Each diapo In Presentation.Slides

For Each forme In diapo.Shapes

If forme.HasTextFrame Then

Set TR = forme.TextFrame.TextRange.Find(FindWhat:=textecherché, MatchCase:=msoFalse, wholewords:=msoFalse)

If Not TR Is Nothing Then

Set TR2 = forme.TextFrame.TextRange.Find(FindWhat:=textecherché & " (x", MatchCase:=msoFalse, wholewords:=msoFalse)

If Not TR2 Is Nothing Then

'ThisWorkbook.Sheets(1).Cells(3, 3).Value = forme.TextFrame.TextRange.Characters.Text

'nombre = Val(Replace(Mid(Sheets(1).Cells(3, 3), InStr(1, Sheets(1).Cells(3, 3), "(x", vbBinaryCompare) + 2), ",", "."))

TexteQuantite = forme.TextFrame.TextRange.Characters.Text

nombre = Val(Replace(Mid(TexteQuantite, InStr(1, TexteQuantite, "(x", vbBinaryCompare) + 2), ",", "."))

k = k + nombre

End If

k = k + 1

End If

End If

Next

Next

ThisWorkbook.Sheets(1).Cells(i, 2).Value = k

Next i

Presentation.Close

appPPoint.Quit

Application.ScreenUpdating = True

End Sub

Bonjour,

voici un code qui fonctionne chez moi .

Sub vérifier_présence()

Set appPPoint = New PowerPoint.Application
Dim Presentation As PowerPoint.Presentation

Application.ScreenUpdating = False

chemin_final = "e:\test.pptx"
k = 0
Set Presentation = appPPoint.Presentations.Open(chemin_final, withWindow:=msoFalse)
For Each diapo In Presentation.Slides
For Each Forme In diapo.Shapes
s = Application.Clean(UCase(Forme.TextFrame.TextRange))
q = InStr(s, UCase("Test (X"))
While q > 0
q1 = InStr(q, s, ")")
If q1 > 0 Then v = Mid(s, q + 7, q1 - q - 7)
k = k + v
s = Mid(s, q1 + 1, Len(s))
q = InStr(s, UCase("Test (X"))
Wend
Next
Next

Presentation.Close

appPPoint.Quit

Application.ScreenUpdating = True
End Sub

Merci, il faudra que je test ça aussi