[Résolu] Difficulté pour arrêter une boucle

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Lebonetletruand

XLDnaute Occasionnel
Bonsoir,

Me revoilà, avec le même fichier. Cette fois ci, je n'arrive pas à stopper une boucle. Je m'explique : Aprés la saisie des commandes en feuil2, j'aimerais avertir l'opérateur s'il décide de vouloir modifier la Feuil1 (base de données nom, adresse,... des adhérents). En cas de modification, les noms ne seront plus en adéquation avec les commandes.
Avec le fichier ci dessous, si vous voulez modifier le premier nom (A), une msg box OkCancel s'ouvre. Si je clique OK, pas de problème la modification est retenue. Si je clique Annuler, il annule la modif de la cellule mais continue d'ouvrir sans cesse la msgbox, si je clique 50 fois sur annuler, elle revient toujours. J'ai tenté en vain Exit Sub mais rien à faire...

Pourriez vous m'apporter des éléments de réponse à cette boucle sans fin?

Merci par avance

Code:
[COLOR="Blue"]Public MemVal As String[/COLOR]

[COLOR="blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]


For i = 8 To 67
' Zone complète = 8 to 67
With Workbooks("Classeur2(1).xls").Sheets("Feuil2")
     Set ColVide = .Range(.Cells(8, i), .Cells(127, i))
End With


' If Target.Value <> MemVal Then
' MsgBox "Ancienne valeur = " & MemVal & " - Nouvelle valeur = " & Target.Value
' End If

If Not Intersect(Cells(i - 4, 2), Target) Is Nothing Then
If Application.WorksheetFunction.CountA(ColVide) <> 0 Then

Msg = "Attention, le tableau des réponses à la commande a commencé à être complété pour  " & MemVal & "." & Chr(13) & Chr(13) & " Un changement dans la liste des adhérents est fortement déconseillé. Si une modification doit être réalisée, les quantités commandées par l'adhérent risquent de ne plus être en adéquation avec son nom."
Style = vbOKCancel + vbExclamation
Title = " Modification déconseillée "
Response = MsgBox(Msg, Style, Title)
If Response = vbCancel Then Target.Value = MemVal: Exit Sub

End If
End If

Next i

End Sub

[COLOR="blue"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/COLOR]
MemVal = Selection.Value
End Sub
 

Pièces jointes

Dernière édition:
Re : Difficulté pour arrêter une boucle

Salut Lebonet d'âne 😀

Tu te trouve dans une procédure : Worksheet_Change
Donc à chaque changement sur ta feuille, cette procédure est appelée

Hors si ta réponse est négative, tu modifie de nouveau ta cellule ... donc ... procédure Worksheet_Change

Pour éviter ce genre de problème, il faut utiliser l'instruction : EnableEvents

VB:
Public MemVal As String
Private Sub Worksheet_Change(ByVal Target As Range)
  For i = 8 To 67
    ' Zone complète = 8 to 67
    With Workbooks("Classeur2(1).xls").Sheets("Feuil2")
      Set ColVide = .Range(.Cells(8, i), .Cells(127, i))
    End With
    ' If Target.Value <> MemVal Then
    ' MsgBox "Ancienne valeur = " & MemVal & " - Nouvelle valeur = " & Target.Value
    ' End If
    If Not Intersect(Cells(i - 4, 2), Target) Is Nothing Then
      If Application.WorksheetFunction.CountA(ColVide) <> 0 Then
        Msg = "Attention, le tableau des réponses à la commande a commencé à être complété pour  " & MemVal & "." & Chr(13) & Chr(13) & " Un changement dans la liste des adhérents est fortement déconseillé. Si une modification doit être réalisée, les quantités commandées par l'adhérent risquent de ne plus être en adéquation avec son nom."
        Style = vbOKCancel + vbExclamation
        Title = " Modification déconseillée "
        Response = MsgBox(Msg, Style, Title)
        If Response = vbCancel Then
          Application.EnableEvents = False
          Target.Value = MemVal
          Application.EnableEvents = True
          Exit Sub
      End If
    End If
  Next i
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  MemVal = Selection.Value
End Sub

A+
 
Re : Difficulté pour arrêter une boucle

Merci Bruno

Je n'ai pas trouvé de jeu de mots pour toi (Sourire), j'avais pensé à Bruno d'Agen mais bon... pas super (Rire)
Merci pour ta réponse éclair et éclairante, ça fonctionne désormais (j'ai juste rajouté un End If qui manquait)

Bonne soirée
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
474
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
497
Réponses
5
Affichages
251
Réponses
4
Affichages
192
Réponses
4
Affichages
245
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
176
Retour