Macro à tout le classeur

Bonjour à toutes et tous,

J'ai intégrer ce code qui fonctionne sur la feuille active et je souhaiterais l'adapter pour que la macro s'applique à toutes les feuilles de mon classeur

Merci

Cordialement

Hugues

Sub images()

Dim x

Dim curshapes As Shape

For Each curShape In ActiveSheet.Shapes

Set x = Intersect(curShape.BottomRightCell, Rows("1:1"))

If x Is Nothing Then curShape.Delete

Next curShape

End Sub

Bonsoir Hugo, bonsoir le forum,

Peut-être comme ça (à adapter) :

Sub images()
Dim O As Worksheet
Dim x
Dim curshapes As Shape

For Each O In Sheets
    'O.Select 'si ça fonctionne sans cette ligne il vaut mieux la supprimer
    For Each curShape In O.Shapes
        Set x = Intersect(curShape.BottomRightCell, O.Rows("1:1"))
        If x Is Nothing Then curShape.Delete
    Next curShape
Next O
End Sub

Bonjour Thauthéme, Bonjour à toutes et tous ,

Ta solution fonctionne parfaitement et je t'en remercie.

Je vais étudier le code pour continuer à apprendre.

Puis je profiter de encore de ton soutien pour adapter ton code pour qu'il isole une feuille du classeur sur laquelle la macro ne s'appliquerait pas ?

Merci beaucoup

Cordialement

Hugues

Bonsoir Hugo bonsoir le forum,

Essaie ça alors :

Sub images()
Dim O As Worksheet
Dim x
Dim curshapes As Shape

For Each O In Sheets
    If Not O.Name = "Feuil1" Then '"Feuil1" à adapter bien évidemment !
        'O.Select 'si ça fonctionne sans cette ligne il vaut mieux la supprimer
        For Each curShape In O.Shapes
            Set x = Intersect(curShape.BottomRightCell, O.Rows("1:1"))
            If x Is Nothing Then curShape.Delete
        Next curShape
    End If
Next O
End Sub

Bonjour Thauthème, Bonjour à toutes et tous,

Merci beaucoup Thauthème, ta solution fonctionne parfaitement et tu as totalement résolu mon problème

Bonne soirée

merci