Macro qui supprime une plage de donnée sauf si elle y rencontre une forme

Bonjour à toutes et à tous,

J'ai réussi à supprimer toute une plage automatiquement, l'étape suivante pour moi est que je puisse renvoyer un message d'erreur "il y a une forme sur la plage" qui m'empêcherait de supprimer cette plage vu si une forme est rencontrée dans celle ci.

Merci d'avance

Anis

Bonjour,

A tester :

Sub TestListeShapes()

Dim FormesConcernees As String

    FormesConcernees = ListeShapes(ActiveSheet, Range("B5:I19"))
    If FormesConcernees <> "" Then
       MsgBox "L'aire ne peut être supprimée, la ou les formes ci-dessous sont présentes : " & Chr(10) & FormesConcernees
    Else
       MsgBox "Aucune forme dans l'aire"
    End If

End Sub

Function ListeShapes(ByVal FeuilleShape As Worksheet, ByVal AireATester As Range) As String

Dim I As Long, J As Long, K As Long
Dim DerniereLigne As Long, DerniereColonne As Long
Dim TabRef(3) As Variant
Dim AireShape As Range
Dim AireValide As Boolean
Dim NomDeLaShape As String

    ListeShapes = ""

    With FeuilleShape

         If .Shapes.Count = 0 Then Exit Function

         For K = 1 To .Shapes.Count

             NomDeLaShape = .Shapes(K).Name

             For I = 0 To 3
                TabRef(I) = 0
             Next I
             AireValide = True

             DerniereLigne = .Cells.SpecialCells(xlCellTypeLastCell).Row
             DerniereColonne = .Cells.SpecialCells(xlCellTypeLastCell).Column

             For I = AireATester.Row To AireATester.Row + AireATester.Rows.Count
                 For J = AireATester.Column To AireATester.Column + AireATester.Columns.Count
                     If .Cells(I, J).Top <= .Shapes(NomDeLaShape).Top Then TabRef(0) = I
                     If .Cells(I, J).Left <= .Shapes(NomDeLaShape).Left Then TabRef(1) = J
                     If .Cells(I, J).Top + .Cells(I, J).Height <= .Shapes(NomDeLaShape).Top + .Shapes(NomDeLaShape).Height Then TabRef(2) = I + 1
                     If .Cells(I, J).Left + .Cells(I, J).Width <= .Shapes(NomDeLaShape).Left + .Shapes(NomDeLaShape).Width Then TabRef(3) = J + 1
                 Next J
             Next I

             For I = 0 To 3
                 If TabRef(I) = 0 Then AireValide = False
             Next I

             If AireValide = True Then
                Set AireShape = .Range(.Cells(TabRef(0), TabRef(1)), .Cells(TabRef(2), TabRef(3)))
                If Not Intersect(AireShape, AireATester) Is Nothing Then
                   ListeShapes = ListeShapes & NomDeLaShape & ", "
                End If
             End If

         Next K

    End With

End Function