Bonjour,

Je cherche, depuis une macro excel, à aller voir si des valeurs présentes dans une colonne excel sont présentes dans des shapes ppt.
L'idée étant que si une valeur est présente, un oui apparait dans la case en face de cette valeur dans excel, sinon un non.

J'ai tenté une macro, qui semble planter avant même le début...
Et par la suite, l'utilisation de la fonction 'find' me parait naïve, n'ayant pu la tester...

Ci-dessous mon code, en espérant que ça pourra en inspirer certains pour me guider

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
58
59
60
61
62
63
Sub vérifier_si_présent()
 
 
    ' Start PowerPoint.
    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.presentation
    Set ppApp = CreateObject("Powerpoint.Application")
    Set ppPres = ppApp.presentation.Open("C:\Users\NG2F637\Desktop\tools\détection shapes\test.pptx")  ' chemin vers fichier ppt
 
    ' Make it visible.
    ppApp.Visible = True
 
    Dim ppSlide As PowerPoint.slide
    Dim ppShape As PowerPoint.Shape
    Dim cherche, trouve As String
 
Application.ScreenUpdating = False
 
Sheets("ici").Select
 
 
    k = 3 ' Parcourir
 
    While Sheets("ici").Cells(k, 2) <> "" ' tant que la cellule n'est pas vide
 
    cherche = Sheets("ici").Cells(k, 2)  ' mettre la valeur à remplacer dans la variable
 
 
 
    For Each ppSlide In ppPres.Slides  ' parcourir les slides
 
        For Each ppShape In ppSlide.Shapes    ' parcourir les shapes
 
 
    On Error Resume Next
 
            Set oTxtRng = ppShape.TextFrame.TextRange()
            Set oTmpRng = oTxtRng.Search(cherche, cherche)
 
            Do While Not oTmpRng Is Nothing
 
 
                Set oTxtRng = oTxtRng.Characters _
                (oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)
                Set oTmpRng = oTxtRng.Search(cherche, cherche)
 
            Loop
        Next ppShape
    Next ppSlide
 
    If oTmpRng = True Then   'au bluffe...
    Sheets("ici").Cells(k, 8).Range = "OUI"
    Else: Sheets("ici").Cells(k, 8).Range = "NON"
    End If
 
    k = k + 1
    Wend
 
ppApp.Quit
 
Set ppApp = Nothing
Application.ScreenUpdating = True
End Sub
Merci pour votre aide et bonne soirée !