Macro - supprimer toutes les images d'une feuille ?

ripou

XLDnaute Nouveau
Bonjour à tous,

J'ai besoin d'un coup de pouce, Via une macro, je souhaiterais supprimer toutes les images de la feuille1
L'enregistreur de macro me donne

Sub testsuppr()

Sheets("Feuil1").Select
ActiveSheet.Shapes("Picture 17").Select
Selection.Delete
ActiveSheet.Shapes("Picture 18").Select
Selection.Delete
ActiveSheet.Shapes("Picture 19").Select
Selection.Delete


End Sub


Le truc c'est que en fontion des feuilles, j'ai un nombre d'images différent avec des appellations différentes dc il me faudrait la ligne de code permettant de supprimer toutes les images d'une feuille sans avoir à les supprimer une par une, ça ne doit pas être bien compliquéé mais comme je suis débutant, je ne trouve pas la solution !

Merci d'avance pour votre aide !

Ripou
 

ripou

XLDnaute Nouveau
Re : Macro - supprimer toutes les images d'une feuille ?

Yes, ça fonctionne, merci beaucoup !
Par contre et je ne m'en étais pas rendu compte mais les images situées sur les 5 premières lignes renvoient à des macros et ces images, je dois les garder ! comment je peux faire pour que la macro supprime toutes les images (la macro que tu m'as donnée Romain SAUF celles des 5 premières lignes ?

Merci d'avance !

Ripou
 

XL_Luc

XLDnaute Occasionnel
Re : Macro - supprimer toutes les images d'une feuille ?

hop hoph op et voila la réponse :

Code:
Sub supression_shapes()
'supression de touts les shapes
'dont le point bas droit ne se trouve pas sur les lignes 1 à 5

Dim x
Dim curshapes As Shape
For Each curShape In ActiveSheet.Shapes
    Set x = Intersect(curShape.BottomRightCell, Rows("1:5"))
    If x Is Nothing Then curShape.Delete
Next curShape

End Sub
 

job75

XLDnaute Barbatruc
Re : Macro - supprimer toutes les images d'une feuille ?

Bonjour le fil,

Une autre solution est d'utiliser dans la macro un tableau des noms des objets qu'on ne veut pas supprimer :

Code:
Sub SupprimerImage()
Dim tablo As Variant, s As Shape
tablo = Array("Rectangle 1", "Rectangle 2", "Rectangle 3")
For Each s In ActiveSheet.Shapes
If IsError(Application.Match(s.Name, tablo, 0)) Then s.Delete
Next
End Sub

A+
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 305
Messages
2 087 077
Membres
103 455
dernier inscrit
saramachado