suppression toutes images dans toutes les feuilles [vba XL2000]

Iaorana®
"J@@" a écrit

J'ai un code pour supprimer toutes les images d'un fichier.
Mais bizarrement le code n'est effectif que depuis la feuille où est le
curseur jusqu'à la dernière feuille.
Comment corriger cela, svp
Merci
J@@

Sub Suppr_Images_TtesFeuils()
' DANGEREUX +++ : supprime TOUTES LES images DE TOUTES LES FEUILLES
On Error Resume Next
Dim SHT As Worksheet
Application.ScreenUpdating = False
For Each SHT In ActiveWorkbook.Worksheets
Application.statusbar=SHT.name
For Each Image In SHT.Pictures
Image.Visible = True
' Image.Select
Image.Delete
Next
Next SHT
End Sub

Iaoana o Geedee tane
Super, cela marche au poil.
La ligne Application.statusbar=SHT.name est juste pour le coté
didactique ? je peux la mettre en commentaire?
merci
J@@

Le 30/03/2011 21:29, Modeste a écrit :

Iaorana®
"J@@" a écrit

le code n'est effectif que depuis la feuille où est
le curseur jusqu'à la dernière feuille.

Sub Suppr_Images_TtesFeuils()
' DANGEREUX +++ : supprime TOUTES LES images DE TOUTES LES FEUILLES
On Error Resume Next
Dim SHT As Worksheet
Application.ScreenUpdating = False
For Each SHT In ActiveWorkbook.Worksheets
Application.statusbar=SHT.name
For Each Image In SHT.Pictures
Image.Visible = True
' Image.Select
Image.Delete
Next
Next SHT
End Sub

Bonjour,

Une autre façon de faire :

'------------------------------
Sub test()
Dim Sh As Worksheet, S As Shape
For Each Sh In Worksheets
For Each S In Sh.Shapes
If TypeName(S.OLEFormat.Object) = "Picture" Then
S.Delete
End If
Next
Next
End Sub
'------------------------------


MichD
--------------------------------------------
"J@@" a écrit dans le message de groupe de discussion : in16k0$58t$1@speranza.aioe.org...

Bonjour à tous
J'ai un code pour supprimer toutes les images d'un fichier.
Mais bizarrement le code n'est effectif que depuis la feuille où est le
curseur jusqu'à la dernière feuille.
Comment corriger cela, svp
Merci
J@@

Sub Suppr_Images_TtesFeuils()
' DANGEREUX +++ : supprime TOUTES LES images DE TOUTES LES FEUILLES
On Error Resume Next
Dim sht As Worksheet
Application.ScreenUpdating = False
For Each sht In ActiveWorkbook.Worksheets
For Each Image In ActiveSheet.Pictures
Image.Visible = True
Image.Select
Image.Delete
Next
ActiveSheet.Next.Select
Next sht
End Sub

Bonjour MichD
Une autre approche qui fonctionne parfaitement.
L'embarras du choix :-)
Merci
@+
J@@

Le 31/03/2011 01:40, MichD a écrit :

'------------------------------
Sub test()
Dim Sh As Worksheet, S As Shape
For Each Sh In Worksheets
For Each S In Sh.Shapes
If TypeName(S.OLEFormat.Object) = "Picture" Then
S.Delete
End If
Next
Next
End Sub
'------------------------------