Function TrouveDate(Plage As Range)
Dim Cel As Range
Dim Nb As Integer
Dim LaDate As Date
For Each Cel In Plage
If Cel.Interior.Color = Range(Application.Caller.Address).Interior.Color Then
Nb = Nb + 1: LaDate = Cel.Value
End If
Next Cel
Select Case Nb
Case 0: TrouveDate = "Non défini"
Case Is > 1: TrouveDate = "Trop de dates"
Case Is = 1: TrouveDate = LaDate
End Select
End Function