XL 2013 Suppression objet dans plage de cellule

[Jacques25]

Bonjour à tous,

Une petite question pour améliorer un code qui marche mais partiellement.
J'ai le code ci-dessous qui me permet de supprimer les objets sur une plage de cellule (zones de texte, formes, photos)
Dim ObjetTraite As Object
Dim Boucle As Long
Dim Plage As Range
Set Plage = Range("$A$16:$BG$37")
For Each ObjetTraite In ActiveSheet.DrawingObjects
For Boucle = Plage.Cells.Count To 1 Step -1
If Plage.Cells(Boucle).Address = ObjetTraite.TopLeftCell.Address Then
ObjetTraite.Delete
Exit For
End If
Next
Next
Set Plage = Nothing

il marche très bien sauf quand je rogne des photos et les recentre sur ma plage ces photos ne sont pas prise en compte. J'imagine que le bord gauche en haut est au-dessus de ma plage.
Je peux difficilement élargir ma plage étant donné qu'il y a des objets en dehors de cette zone que je souhaite conserver.
Auriez vous une idée pour que toutes les formes qui traverse ma plage de cellule soient supprimées?

Merci d'avance pour aide précieuse.
Bonne journée à tous.

Jack

 

[job75]

Bonjour Jacques25,

Sub SupprObjet()
Dim plage As Range, o As Object
Set plage = [A16:BG37] 'plage à adapter
For Each o In ActiveSheet.DrawingObjects
    If Not Intersect(o.TopLeftCell, plage) Is Nothing Then o.Delete
Next
End Sub

A+

 

[eriiic]

Bonjour,

Si je peux me permettre une petite modif job75, pour tenir compte de tous les cas de figure :

Sub SupprObjet()
Dim plage As Range, o As Object
Set plage = [A16:BG37] 'plage à adapter
For Each o In ActiveSheet.DrawingObjects
    If Not Intersect(Range(o.TopLeftCell, o.BottomRightCell), plage) Is Nothing Then o.Delete
Next
End Sub

eric

 

[Jacques25]

Bonjour Job75, Eriiiic, le forum,

Merci pour vos codes, le 1er essai n'a pas fonctionné à 100% avec la modif d'ériiiic et le 2ème essai y'a pas eu de soucis. Je n'ai pas réussi à voir dans quelle configuration ça ne marchait pas.
Je vais l'utiliser comme ça et je verrai au quotidien ce qui pèche.

Bonne journée à tous.
@ plus

Jack