Microsoft 365 Interdire L'écriture sur une ligne si la date est dépassée

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range

    Select Case True
        Case Target.Count > 1
        Case Intersect(Target, [D7:T1119]) Is Nothing
        Case Not CheckDate
            Application.EnableEvents = False
            Set R = Columns("B").Find(Format(Date - 2, "dddd dd mmmm"), LookIn:=xlValues)
            If Not R Is Nothing Then Cells(R.Row, "B").Select Else Cells(Target.Row, "B").Select
            Application.EnableEvents = True
    End Select
End Sub
Function CheckDate() As Boolean
Dim Refdate As Date
    
    CheckDate = True
    Refdate = Cells(Selection.Row, "B").MergeArea.Cells(1).Value
    
    Select Case Date
        Case Is > Refdate + 2:  MsgBox "trop tard": CheckDate = False
        Case Is >= Refdate + 1: MsgBox "il est temps"
        Case Else
    End Select
    
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fait, x As String

Dim R As Range
    Select Case True
        Case Target.Count > 1
        Case Intersect(Target, [D7:T1119]) Is Nothing
        Case Not CheckDate
            Application.EnableEvents = False
            Application.Undo
            Set R = Columns("B").Find(Format(Date - 2, "dddd dd mmmm"), LookIn:=xlValues)
            If Not R Is Nothing Then Cells(R.Row, "B").Select Else Cells(Target.Row, "B").Select
            Application.EnableEvents = True
    End Select

fait = ActiveCell.Value
.....
.....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Variant
lig = Application.Match(CDbl(Date - 2), [B:B])
If IsError(lig) Then Exit Sub
If Intersect(Target, Rows("7:" & lig + 2)) Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
Application.Undo 'annule les modifications
Application.EnableEvents = True 'réactive les évènements
End Sub