XL 2010 MFC sur couleur texte

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range, Cel As Range, Mini As Double, Maxi As Double
   Set Rng = Me.[A3:A34]
   Mini = WorksheetFunction.Min(Rng)
   Maxi = WorksheetFunction.Max(Rng)
   If Intersect(Rng, Target) Is Nothing Then Exit Sub
   For Each Cel In Rng
      CoulTxtBleuJaunRoug Cel, Mini, Maxi
      Next Cel
   End Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range, Mini As Double, Maxi As Double, Cel As Range
   Set Rng = Me.[K6:L371,N6:O371]
   If Intersect(Rng, Target) Is Nothing Then Exit Sub
   Mini = WorksheetFunction.Min(Rng)
   Maxi = WorksheetFunction.Max(Rng)
   For Each Cel In Rng
      CoulTxtBleuJaunRoug Cel, Mini, Maxi
      Next Cel
   End Sub

Option Explicit
Sub CoulTxtBleuJaunRoug(ByVal Cel As Range, ByVal Mini As Double, ByVal Maxi As Double)
   Const NivMax = 15, NbCoulDif = NivMax + 1
   Dim Niv As Long, A As Double
   If VarType(Cel.Value) <> vbDouble Then Cel.Font.Color = &H0: Exit Sub
   If Maxi > Mini Then
      Niv = Int(Borné(0, NbCoulDif * (Cel.Value - Mini) / (Maxi - Mini), NivMax))
      A = IntpoHyp(Niv, 0, 4, NivMax / 2, 1, NivMax, 0)
   Else: A = 1: End If
   With New Couleur: .EAF 218.75, A: Cel.Font.Color = .C: End With
   End Sub
Private Function Borné(ByVal LimInf As Double, ByVal V As Double, ByVal LimSup As Double) As Double
   Borné = (LimInf + Abs(V - LimInf) - Abs(LimSup - V) + LimSup) / 2
   End Function
Function IntpoHyp(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double, _
                                     ByVal X3 As Double, ByVal Y3 As Double) As Double
   Dim dX As Double, dY As Double
   dX = X3 - X1: If dX = 0 Then IntpoHyp = (2 ^ 53 - 1) * 2 ^ 971: Exit Function
   dY = Y3 - Y1: If dY = 0 Then IntpoHyp = Y1: Exit Function
   IntpoHyp = Y1 + dY * F0à1xyInt((X - X1) / dX, (X2 - X1) / dX, (Y2 - Y1) / dY)
   End Function
Function F0à1xyInt(ByVal X As Double, ByVal XInt As Double, ByVal YInt As Double) As Double
   Dim N As Double, D As Double
   N = YInt * (1 - XInt) * X: D = XInt * (1 - YInt) + X * (YInt - XInt)
   If Abs(N) < Abs(D) * 2 ^ 40 Then F0à1xyInt = N / D Else F0à1xyInt = Sgn(N) * 2 ^ 40
   End Function
Function IntpoLin(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double) As Double
   IntpoLin = Y1 + (Y2 - Y1) * (X - X1) / (X2 - X1)
   End Function