XL 2021 Souci avec une macro lors d'un changement de "statut"

fanou06 · 27 Juillet 2023

Bonjour,

Sur la feuille RDV il y a une macro qui permet selon un "état" de paiement (colonne F), une colorisation de la ligne entière.
Lorsque la macro est exécutée initialement c'est ok.
Mais si je change le statut de cet "état" et que j'exécute à nouveau la macro, la colorisation reste la même.

VB:

Sub EtatCommandes()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    ' Nom de la feuille de calcul
    Set ws = ThisWorkbook.Worksheets("RDV")

    ' Définit la plage de recherche du texte "ANNULE" ou "GRATUIT"
    Set rng = ws.Range("F:F")

    ' Parcourt chaque cellule de la colonne F
    For Each cell In rng
        ' Vérifie si la cellule contient le texte "ANNULE" (en ignorant la casse)
        If StrComp(cell.Value, "ANNULE", vbTextCompare) = 0 Then
            ' Si "ANNULE" est trouvé, colore toute la ligne de A à I en gris
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(211, 211, 211)
        ElseIf StrComp(cell.Value, "GRATUIT", vbTextCompare) = 0 Then
            ' Si "GRATUIT" est trouvé, colore toute la ligne de A à I en jaune
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(255, 255, 0)
            ElseIf StrComp(cell.Value, "NON PAYE", vbTextCompare) = 0 Then
            ' Si "NON PAYE" est trouvé, colore toute la ligne de A à I en rouge
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(255, 0, 0)
        End If
    Next cell
End Sub

Une piste d'amélioration ?

Merci.

mapomme · 27 Juillet 2023

Bonjour @fanou06 ,

Tout d'abord, quelques réflexions :

Votre tableau structuré RdV s'étend de la ligne 2 jusqu'à la dernière ligne de la feuille . C'est un non-sens. Dans un tableau structuré, on évite les lignes vides.
Une boucle ne se fait jamais sur une colonne complète alors même que presque toutes les lignes sont vides .

Je propose trois méthodes :

1 - Sur la feuille "RDV", la macro suivante :

VB:

Sub EtatCommandes()
Dim x
   For Each x In ThisWorkbook.Worksheets("RDV").Range("a1").ListObject.ListRows
      Select Case x.Range(1, 6)
         Case "ANNULE": x.Range.Interior.Color = RGB(211, 211, 211)
         Case "GRATUIT": x.Range.Interior.Color = RGB(255, 255, 0)
         Case "NON PAYE"...

Phil69970 · 27 Juillet 2023

Bonjour @fanou06

Tu as oublié la condition "Payé"

Ta macro parcourt 1 million de lignes alors que tu te sers de moins de 500 lignes
Faire un tableau structuré avec 1 million de lignes n'est pas une bonne idée puisque justement un TS est fait pour s'agrandir avec les formules qu'il contient.
Une MFC pourrait peut être le faire donc sans code VBA et avec la mise à jour automatique

mapomme · 27 Juillet 2023

Bonjour @fanou06 ,

Tout d'abord, quelques réflexions :

Votre tableau structuré RdV s'étend de la ligne 2 jusqu'à la dernière ligne de la feuille . C'est un non-sens. Dans un tableau structuré, on évite les lignes vides.
Une boucle ne se fait jamais sur une colonne complète alors même que presque toutes les lignes sont vides .

Je propose trois méthodes :

1 - Sur la feuille "RDV", la macro suivante :

VB:

Sub EtatCommandes()
Dim x
   For Each x In ThisWorkbook.Worksheets("RDV").Range("a1").ListObject.ListRows
      Select Case x.Range(1, 6)
         Case "ANNULE": x.Range.Interior.Color = RGB(211, 211, 211)
         Case "GRATUIT": x.Range.Interior.Color = RGB(255, 255, 0)
         Case "NON PAYE": x.Range.Interior.Color = RGB(255, 0, 0)
         Case Else: x.Range.Interior.ColorIndex = xlColorIndexNone
      End Select
   Next x
End Sub

2 - Sur la feuille "RDV (1)", c'est automatique. On colore le tableau dès qu'une valeur dans la 6ème colonne est modifiée. Le code est dans le module associé à la feuille "RDV (1)" :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim x
   If Intersect(Target, ThisWorkbook.Worksheets("RDV (1)").Range("a1").ListObject.ListColumns(6).Range) Is Nothing Then Exit Sub
   Application.ScreenUpdating = False
   For Each x In ThisWorkbook.Worksheets("RDV (1)").Range("a1").ListObject.ListRows
      Select Case x.Range(1, 6)
         Case "ANNULE": x.Range.Interior.Color = RGB(211, 211, 211)
         Case "GRATUIT": x.Range.Interior.Color = RGB(255, 255, 0)
         Case "NON PAYE": x.Range.Interior.Color = RGB(255, 0, 0)
         Case Else: x.Range.Interior.ColorIndex = xlColorIndexNone
      End Select
   Next x
End Sub

3 - Sur la feuille "RDV (2)" pas de macro. C'est une MFC qui colore chaque ligne du tableau (ma préférée pour le cas en question).

fanou06 · 27 Juillet 2023

Ok, merci beaucoup

XL 2021 Souci avec une macro lors d'un changement de "statut"

fanou06

XLDnaute Occasionnel

Pièces jointes

mapomme

Phil69970

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

fanou06

XLDnaute Occasionnel

Discussions similaires