XL 2010 Recherche d'images dans une plage de cellules

[Philippe LAMACHE]

Bonjour à tous,

J'ai récupéré du code sur ce forum (Merci Gorfael - post du 16/02/2011) que j'ai essayé de modifier sans succès.

Sub TestSiImgDansPlg()
Dim Sh As Shape, Plage As Range, Plg As Range'<= Modif OK
For Each Sh In ActiveSheet.Shapes
    If Sh.Type = msoPicture Then '<= Modif OK
        If Plage Is Nothing Then
            Set Plage = Sh.TopLeftCell
        Else
            Set Plage = Union(Plage, Sh.TopLeftCell)
        End If
    End If '<= Modif OK
Next Sh
'MsgBox "Adresses des cellules : " & Plage.Address(0, 0)
    Set Plg = Range("A118:N151") '<= Modif OK
    If Plage.Address(0, 0) = Plg.Address Then MsgBox "OK" '<= Modif PAS OK
End Sub

Je souhaiterais tester si, dans ma plage "A118:N151", se trouve une ou des image(s) mais malgré la présence d'une image ("A120") elle n'est pas détectée.
Pour résumer, une solution afin de pouvoir chercher dans ma plage et non dans la feuille entière (car d'autres images sont dans la feuille et ne doivent pas être prises en compte).

Quelqu'un aurait-il quelque chose à me proposer ?
Par avance, merci.

 

[danielco]

Bonjour,

Remplace :

If Plage.Address(0, 0) = Plg.Address Then MsgBox "OK"

par :

If Not Intersect(Plage, Plg) Is Nothing Then MsgBox "OK"

Cordialement.

Daniel

 

[Philippe LAMACHE]

Bonjour Danielco,
Merci de ta réponse. J'ai essayé mais comme j'ai plusieurs images dans ma feuille (1 seule dans ma plage de recherche) le 'Plage.Address(0,0)' me liste toutes les adresses de toutes mes images et ne veut donc pas comparer avec le 'c.Address'.

En continuant à fouiller sur le net, j'ai réussi à atteindre mon but :

Sub TestSiImgDansPlg()
Dim Sh As Shape, plage As Range, Plg As Range
Art1 = "OBSERVATIONS"
Art2 = "Conforme à"
With ActiveSheet.Range("A:N")
    Set Cellule = .Find(Art1, LookAt:=xlPart)
    CelD = Cellule.Offset(1, 0).Address
End With
With ActiveSheet.Range("A:N")
    Set Cellule = .Find(Art2, LookAt:=xlPart)
    Cellule.Offset(-1, 1).Select
    ActiveCell.Offset(0, -1).Select
    CelF = ActiveCell.Address
End With
For Each Sh In ActiveSheet.Shapes
    If Sh.Type = msoPicture Then
        If plage Is Nothing Then
            Set plage = Sh.TopLeftCell
        Else
            Set plage = Sh.TopLeftCell
            For Each c In Range(CelD, CelF)
                If plage.Address = c.Address Then MsgBox "Image présente dans cette plage (" & plage.Address & ")."
            Next c
       End If
    End If
Next Sh
End Sub

Oui, c'est un peu "barbare" mais je m'en contenterais.