XL 2016 mfc sur date > aujourdhui() en vba

[louatt]

Bonjour à tous,

j'utilise le code ci-dessous pour me mettre en couleur une ligne sur deux sur les colonnes allant de A à M.

Je cherche à modifier ce code pour avoir le texte de la cellule K en vert si la date est supérieur à aujourd'hui et inversement en rouge.

Par avance je vous remercie pour votre aide.

Cordialement

Dim DerLig As Long, Sht As Worksheet
  ' Définir la feuille de destination de la MFC
  Set Sht = Sheets("BD_Famas")
  ' Mémoriser la dernière ligne remplie
  DerLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Avec les cellules de la colonne A à M
  With Sht.Range(Sht.Cells(DerLig, 1), Sht.Cells(DerLig, 13))
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
                          "=ET(" & Cells(DerLig, 1).Address & "<>"""";MOD(LIGNE();2)=0)"
    With .FormatConditions(1).Borders
      .LineStyle = xlContinuous
      .ThemeColor = 5
      .TintAndShade = 0.399945066682943
      .Weight = xlThin
      .ColorIndex = 48 'xlAutomatic 'Gris foncé
    End With
    .FormatConditions(1).Interior.ColorIndex = 24
    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & Cells(DerLig, 1).Address & "<>"""""
    With .FormatConditions(2).Borders
      .LineStyle = xlContinuous
      .ThemeColor = 5
      .TintAndShade = 0.399945066682943
      .Weight = xlThin
      .ColorIndex = 48 'xlAutomatic 'Gris foncé
    End With

 

[Lone-wolf]

Bonjour louatt

Il serait préférable de mettre un fichier exemple. Sinon un exemple

Option Explicit

Sub MFPerso()
Dim Sht As Worksheet, derlig As Long, x As Long, i As Long, tbl

    Set Sht = Sheets("BD_Famas")
    With Sht
        derlig = .Range("a" & Rows.Count).End(xlUp).Row
        .Range("a1:m1").Interior.Color = RGB(21, 96, 189)
        .Range("a1:m1").Font.Color = RGB(223, 242, 255)
        .Range("a2:m" & derlig).Interior.Color = RGB(197, 217, 241)

        For i = 2 To derlig Step 2
            .Range(.Cells(i, 1), .Cells(i, 13)).Interior.Color = RGB(242, 242, 242)
        Next i

        'Ici j'ai mis +1, car elle ne prend pas en compte la dernière ligne ???
        tbl = .Range("k2:k" & derlig + 1)

        For x = 2 To UBound(tbl)
            If .Cells(x, "K") > Date Then
                .Cells(x, "K").Interior.Color = vbGreen
            Else
                .Cells(x, "K").Interior.Color = vbRed
                .Cells(x, "K").Font.Color = vbWhite
            End If
        Next x
    End With

End Sub

Pour les couleurs RGB, voci un site: couleurs RGB

 

[louatt]

Bonsoir, merci pour l'aide je vais essayer de l'adapter à ma situation.

Bonne soirée