Microsoft 365 colorier une rangée de cellules

[Marvin57]

tout le monde,

dans le code ci dessous Franc58 m'a modifié ce dernier pour mettre en couleur la cellule de jour sélectionnée.
Cela fonctionne très bien.

   For Each Cell In ActiveSheet.Range("B5:AF159")
    If Cell.Value = [Today()] Then
    Cell.Select
    Cell.Interior.Color = RGB(0, 255, 0)
    Cell.Font.Color = RGB(255, 0, 0)
    End If
Next

J'avais oublié un détail.

Est-il possible de lui dire de colorier également les 10 cellules en dessous de la cellule sélectionnée ?

Merci d'avance à vous tous pour votre aide

Marvin57

 

[Marvin57]

J'abonde dans la formule MFC:
Regarde la pièce jointe 1193184
Avec en module :

Function Tod(Cel As Range) As Boolean
    If Cel = Date Then
        Tod = True
    Else
        For L = Cel.Row To Application.Max(Cel.Row - 10, 1) Step -1
            If Cells(L, Cel.Column) = Date Then
                Tod = True
                Exit For
            End If
        Next
    End If
End Function

Bonjour fanch55,

Merci pour ce travail. Je l'ai placé et cela fonctionne. Je surveillerai toute la semaine et je donnerai des nouvelles.
Merci beaucoup en attendant.

Marvin57