Macro récalcitrante

Bonjour,

J'ai une macro sur un bouton qui me sert à supprimer des lignes qui contiennent des images d'un genre de formulaire.

Tout fonctionne bien tant qu'une des cellules n'a pas de valeur. Dès qu'elle contient une valeur la macro plante tout à la fin, elle me supprime bien toutes les autres lignes et toutes les images sauf cette satanée dernière ligne !

J'ai une piste mais pas de solution. La valeur de la cellule se choisit avec une liste déroulante à laquelle est liée d'autre fonction Worksheet_Change, les autres lignes supprimer sont dans le même cas et ne posent pas de problème....

Je cherche depuis un moment mais je coince, merci pour votre aide.

Le code : toute la macro s'exécute jusqu'à la suppression de la dernière ligne

Sub supprimer_la_piece()

Application.ScreenUpdating = False

NomBoutonSupprimerPiece = ActiveSheet.Shapes(Application.Caller).Name

PositionBoutonSupprimerPiece = ActiveSheet.Shapes(NomBoutonSupprimerPiece).TopLeftCell.Address

PositionLogo = Range(PositionBoutonSupprimerPiece).Offset(0, -7).Address

PositionDelete = Range(PositionBoutonSupprimerPiece).Offset(1, -7).Address

Do While Range(PositionDelete).Value = "" And Range(PositionDelete).Offset(1, 0).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin" Or Range(PositionDelete).Value <> "" And Range(PositionDelete).Offset(1, 0).Value = "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin" Or Range(PositionDelete).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin"

Range(PositionLogo).EntireRow.Delete

Loop

Dim Image As Shape

For Each Image In ActiveSheet.Shapes

If Not Intersect(Image.TopLeftCell, Range(PositionBoutonSupprimerPiece).EntireRow) Is Nothing Then

Image.Delete

End If

Next Image

Range(PositionBoutonSupprimerPiece).EntireRow.ClearContents

Range(PositionDelete).EntireRow.Delete

Range(PositionDelete).Offset(-1, 0).EntireRow.Delete

Application.CutCopyMode = False

Range(PositionDelete).Offset(2, 7).Select

End Sub

Bonjour toutes et tous

Sub supprimer_la_piece()
Application.ScreenUpdating = False
NomBoutonSupprimerPiece = ActiveSheet.Shapes(Application.Caller).Name
PositionBoutonSupprimerPiece = ActiveSheet.Shapes(NomBoutonSupprimerPiece).TopLeftCell.Address
PositionLogo = Range(PositionBoutonSupprimerPiece).Offset(0, -7).Address
PositionDelete = Range(PositionBoutonSupprimerPiece).Offset(1, -7).Address
Do While Range(PositionDelete).Value = "" And Range(PositionDelete).Offset(1, 0).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin" Or Range(PositionDelete).Value <> "" And Range(PositionDelete).Offset(1, 0).Value = "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin" Or Range(PositionDelete).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin"
Range(PositionLogo).EntireRow.Delete
Loop
Dim Image As Shape
For Each Image In ActiveSheet.Shapes
If Not Intersect(Image.TopLeftCell, Range(PositionBoutonSupprimerPiece).EntireRow) Is Nothing Then
Image.Delete
End If
Next Image
Range(PositionBoutonSupprimerPiece).EntireRow.ClearContents
Range(PositionDelete).EntireRow.Delete
Range(PositionDelete).Offset(-1, 0).EntireRow.Delete
Application.CutCopyMode = False
Range(PositionDelete).Offset(2, 7).Select
End Sub

peut être en mettant Else @ tester:

Sub supprimer_la_piece()
' déclaration variable
Dim Image As Shape
Application.ScreenUpdating = False
NomBoutonSupprimerPiece = ActiveSheet.Shapes(Application.Caller).Name
PositionBoutonSupprimerPiece = ActiveSheet.Shapes(NomBoutonSupprimerPiece).TopLeftCell.Address
PositionLogo = Range(PositionBoutonSupprimerPiece).Offset(0, -7).Address
PositionDelete = Range(PositionBoutonSupprimerPiece).Offset(1, -7).Address
Do While Range(PositionDelete).Value = "" And Range(PositionDelete).Offset(1, 0).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin" Or Range(PositionDelete).Value <> "" And Range(PositionDelete).Offset(1, 0).Value = "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin" Or Range(PositionDelete).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "" And Range(PositionDelete).Offset(1, 0).Value <> "Fin"
Range(PositionLogo).EntireRow.Delete
Loop

For Each Image In ActiveSheet.Shapes
If Not Intersect(Image.TopLeftCell, Range(PositionBoutonSupprimerPiece).EntireRow) Is Nothing Then
Image.Delete
Next Image

Else
Range(PositionBoutonSupprimerPiece).EntireRow.ClearContents
Range(PositionDelete).EntireRow.Delete
Range(PositionDelete).Offset(-1, 0).EntireRow.Delete
Application.CutCopyMode = False
Range(PositionDelete).Offset(2, 7).Select
End Sub
Application.ScreenUpdating = True
End If

pas certain à sauvegarder avant en cas de plantage

crdlt,

André

C'est une excellente piste qui ne fonctionne pas mais qui conforte l'idée que le problème viens de Worksheet_Change car cette fois il me renvoie l'erreur à cette macro.

Le truc bizarre c'est que j'ai essayé de supprimer par plage, pareil....ligne par ligne, pareil.... d'abord les images, pareil....en premier la dernière ligne, l'avant dernière ligne fait l'erreur à son tour.... je commence à manquer d'idée )