Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Macro ne fonctionne plus ?

fanou06

XLDnaute Occasionnel
Bonjour,

J'ai un souci de MACRO sur l'onglet "dépenses détaillées".
En effet, lorsque j'exécute la macro "TriColor", celle ci ne change pas les couleurs selon les critères de D.

Une piste ?
Merci.

VB:
Sub TriColor()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    ' Nom de la feuille de calcul
    Set ws = ThisWorkbook.Worksheets("Dépenses détail")

    ' Définit la plage de recherche du texte "CRITERE DE CHOIX"
    Set rng = ws.Range("D:D")

    ' Parcourt chaque cellule de la colonne D
    For Each cell In rng
        ' Vérifie si la cellule contient le texte "FATFAT ou ZURICH ou ROMANDE ENERGIE ou SWISSCOM" (en ignorant la casse)
        If StrComp(cell.Value, "FATFAT", vbTextCompare) = 0 Then
            ' Si "FATFAT" est trouvé, colore toute la ligne de A à I en vert d'eau
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(176, 242, 182)
        ElseIf StrComp(cell.Value, "ZURICH", vbTextCompare) = 0 Then
            ' Si "ZURICH" est trouvé, colore toute la ligne de A à I en vert d'eau
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(176, 242, 182)
            ElseIf StrComp(cell.Value, "ROMANDE ENERGIE", vbTextCompare) = 0 Then
            ' Si "ROMANDE ENERGIE" est trouvé, colore toute la ligne de A à I en vert d'eau
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(176, 242, 182)
            ElseIf StrComp(cell.Value, "SWISSCOM", vbTextCompare) = 0 Then
            ' Si "SWISSCOM" est trouvé, colore toute la ligne de A à I en vert d'eau
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(176, 242, 182)
            ElseIf StrComp(cell.Value, "VITA", vbTextCompare) = 0 Then
            ' Si "VITA" est trouvé, colore toute la ligne de A à I en vert d'eau
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(176, 242, 182)
            
            ElseIf StrComp(cell.Value, "MÜLLER", vbTextCompare) = 0 Then
            ' Si "MÜLLER" est trouvé, colore toute la ligne de A à I en bleu azurin
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(169, 234, 254)
            ElseIf StrComp(cell.Value, "LA POSTE", vbTextCompare) = 0 Then
            ' Si "LA POSTE" est trouvé, colore toute la ligne de A à I en bleu azurin
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(169, 234, 254)
            ElseIf StrComp(cell.Value, "INTERDISCOUNT", vbTextCompare) = 0 Then
            ' Si "INTERDISCOUNT" est trouvé, colore toute la ligne de A à I en bleu azurin
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(169, 234, 254)
            ElseIf StrComp(cell.Value, "VMCV", vbTextCompare) = 0 Then
            ' Si "VMCV" est trouvé, colore toute la ligne de A à I en bleu azurin
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(169, 234, 254)
            ElseIf StrComp(cell.Value, "PAYOT LIBRAIRIE", vbTextCompare) = 0 Then
            ' Si "PAYOT LIBRAIRIE" est trouvé, colore toute la ligne de A à I en bleu azurin
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(169, 234, 254)
        End If
    Next cell
End Sub
 

Pièces jointes

  • TABLEAU_SUIVI_REGLEMENT_RDV PATIENT_2023 V2.xlsm
    158 KB · Affichages: 2
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…