[XL-2003] Problème de boucle infinie [Résolu]

[SkyCorp]

Bonjour,

Je souhaite copier une cellule (D1) de ma feuille Excel, plus précisément le dessin situé sur cette cellule, dans toute cellule d'une colonne (sauf la première cellule) obéissant à un certain critère (par exemple : valeur de ma cellule = "x")

Pour ce faire, j'ai rédigé le code suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSheet As Excel.Worksheet  ' Feuille
Dim Sh As Shape
Dim lLine As Long  ' Numéro de ligne
 
Set oSheet = ThisWorkbook.Sheets("nom_onglet")
' ou bien (si ça marche) : Set oSheet = ActiveSheet
 
' Pour chaque ligne de la feuille (on démarre ici de la ligne 2 ; si besoin, changer le "+1")
For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
' ou : For lLine = 2 To oSheet.UsedRange.Rows.Count
    ' On commence par supprimer les précédents dessins
    For Each Sh In oSheet.Shapes
        If Sh.TopLeftCell.Address = Range("B" & lLine).Address Then
            Sh.Delete
        End If
    Next
    If Range("B" & lLine).Value = "x" Then
        Range("D1").Select
        Selection.Copy
        Range("B" & lLine).Select
        ActiveSheet.Paste
    End If
Next
End Sub

Le problème est que ce code me fait entrer dans une boucle infinie au niveau de la première cellule obéissant à ce critère et refuse de lire les cellules suivantes.

J'ai essayé d'utiliser un Exit For au niveau du second If, mais rien ne change, le code refuse de passer à la ligne suivante.

Quelqu'un aurait-il une idée pour me sortir de là ?

[ZebreLoup]

Je pense que le problème vient du fait que ton code est dans le worksheet_change et que lui-même provoque des changements sur la feuille.

J'ai essayé en le mettant dans une procédure standard, ça marche.

[FreeZf]

Je confirme que le souci vient bien du positionnement de la macro (worksheet_change) qui est executé à chaque changement et donc en boucle...

[gFZT82]

Bonjour,

Essaie en utilisant Application.EnableEvents

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSheet As Excel.Worksheet  ' Feuille
Dim Sh As Shape
Dim lLine As Long  ' Numéro de ligne
Application.EnableEvents = False
 
Set oSheet = ThisWorkbook.Sheets("nom_onglet")
' ou bien (si ça marche) : Set oSheet = ActiveSheet
 
' Pour chaque ligne de la feuille (on démarre ici de la ligne 2 ; si besoin, changer le "+1")
For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
' ou : For lLine = 2 To oSheet.UsedRange.Rows.Count
    ' On commence par supprimer les précédents dessins
    For Each Sh In oSheet.Shapes
        If Sh.TopLeftCell.Address = Range("B" & lLine).Address Then
            Sh.Delete
        End If
    Next
    If Range("B" & lLine).Value = "x" Then
        Range("D1").Select
        Selection.Copy
        Range("B" & lLine).Select
        ActiveSheet.Paste
    End If
Next
 
Application.EnableEvents = True
End Sub

Cordialement.

[ZebreLoup]

Essaie aussi en sortant la suppression des dessins de ta boucle, il suffit de vérifier pour chaque dessin qu'il est dans ta zone, pas besoin de vérifier chaque dessin pour chaque cellule.

[SkyCorp]

La solution de gFZT82 marche impec
Merci !

Concernant le worksheet_change, je cherche à vérifier à tout instant si la valeur de n'importe quelle cellule de la colonne B change ou non pour y afficher ou supprimer l'image souhaitée.

Envoyé par ZebreLoup

Essaie aussi en sortant la suppression des dessins de ta boucle, il suffit de vérifier pour chaque dessin qu'il est dans ta zone, pas besoin de vérifier chaque dessin pour chaque cellule.

Pour les dessins, ils sont tous situés dans la colonne à analyser. Et comme je n'en ai pas tant que ça, autant les supprimer tous directement.

Il doit y avoir moyen d'améliorer le code, mais je me focalise sur un autre point dans l'immédiat : je copie actuellement le dessin en copiant toute la cellule mais j'aimerai à présent ne copier que le dessin pour ne pas modifier le format de mes cellules.


Edit : Pour un meilleur suivi, j'ai ouvert un nouveau sujet (ici).
En tout cas, merci à tous pour votre aide.