VBA supprimer tous les objets d'une feuille sauf un

Bonsoir à tous,

Dans une macro, selon un choix je copie une cellule contenant un objet (image) venant d'une autre feuille.

çà marche, mais à chaque fois je suis obligé de supprimer l'objet précédent.

Ne connaissant pas le nom de l'image, je supprime tous les objets de la feuille avec cette ligne de code:

 ActiveSheet.DrawingObjects.Delete

Ce qui me vire également les boutons nécessaires à la feuille. (boutons groupés et groupe nommé "dudu")

Je cherche donc un code qui supprimerait tous les objets sauf "dudu"

cela est-il possible ?

Bonne soirée

Claude.

Bonsoir,

As-tu essayé avec SHAPES ?

A te relire

Dan

Bonsoir Dan,

Je ne connais pas le nom de l'objet à supprimer (Shapes),

Je connais seulement celui du groupe à conserver "dudu"

Claude.

Re,

Clique droite sur l'objet pour le sélectionner. Puis en haut à gauche dans une boite à coté de la barre de formule, tu vois le nom de ton objet et un numéro.

Prends ce numéro puis SHAPES(Numéro )

A te relire

Dan

re,

Merci Dan, mais j'ai une centaine d'objets différents, tu vois le B.... !

C'est pas vraiment la solution que je souhaitais

Pour le moment, je supprime tout et je recopie le groupe "dudu" sur ma feuille, mais c'est

pas très Top !

Amicalement

Claude.

édit : l'objet à supprimer est toujours dans la cellule C2

Salut le forum

Claude essaye ceci pour voir (Pas tester)

Sub efface()
Dim img As Object

For Each img In ActiveSheet.Shapes 
  img.Delete
Next

End Sub

Ou peut-etre simplement

activeSheet.Pictures.Delete

Mytå

Re le forum

Avec une petite recherche, un code de SilkyRoad (MVP)

Dans cet exemple , l'image insérée à l'emplacement de la plage D3:E8 est automatiquement nommée "Cible"

si le nom de l'image existe déja dans la feuille , l'ancienne image est supprimée

Sub InsertionImage()
Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object

On Error GoTo fin:
For Each ShapeObj In ActiveSheet.DrawingObjects ' boucle pour supprimer ancienne image
If ShapeObj.Name = "cible" Then ActiveSheet.Shapes("cible").Delete
Next ShapeObj

Application.Dialogs(xlDialogInsertPicture).Show
Set Emplacement = Range("D3:E8")

Set image = ActiveSheet.DrawingObjects(2) 'adapter selon nombre total de shapes dans feuille
With image.ShapeRange
.Name = "cible" ' nommer l'image insérée ( pour la supprimer plus facilement ensuite )
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With

Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue . "
End Sub

Mytå

Bonsoir Mytå,

Hélas non !

çà me vire mon groupe "dudu"

Merci et Bonne année 2009

Claude.

édit: pas vu ton dernier message, je vais tester

re,

Mytå, finalement ton code fonctionne en ajoutant un If

Sub efface() 'de Mytå
Dim img As Object
    For Each img In ActiveSheet.Shapes
        If img.Name <> "dudu" Then img.Delete
    Next
End Sub

Merci beaucoup

amicalement

Claude.

Re le forum

On n'avait pas ton fichier, mais tu as résolu ta question...

Mytå