Option Explicit
Function NomCouleur(ByVal Rng As Range) As String
Dim Coul As New Couleur, A48&, P&, S&, Princ$, Secon$, Foncé&, Clair&
Coul.C = Rng.Interior.Color
If Coul.F = 0 Then
Select Case Coul.E
Case 0: NomCouleur = "noir"
Case Is < 125: NomCouleur = "gris très foncé"
Case Is < 475: NomCouleur = "gris foncé"
Case Is <= 525: NomCouleur = "gris"
Case Is <= 875: NomCouleur = "gris clair"
Case Is < 1000: NomCouleur = "gris très clair"
Case Else: NomCouleur = "blanc": End Select
Else
A48 = Int(Coul.A * 8 + 0.5) Mod 48: If A48 < 0 Then A48 = A48 + 48
P = (A48 + 4) \ 8: S = A48 \ 8
Princ = Array("rouge", "jaune", "vert", "cyan", "bleu", "magenta")(P Mod 6)
Secon = Array("orange", "chartreuse", "émeraude", "azur", "violet", "fuchsia")(S)
S = Abs(A48 - 8 * P): If S > 4 Then S = 8 - S
Select Case S
Case 0: NomCouleur = Princ
Case 1: NomCouleur = Princ & " lég. " & Secon
Case 2: NomCouleur = "mi-" & Princ & " mi-" & Secon
Case 3: NomCouleur = Secon & " lég. " & Princ
Case 4: NomCouleur = Secon
Case Else: NomCouleur = S: End Select
Select Case Coul.E - Coul.EThéoMin: Case Is > 400: Clair = 2: Case Is > 62.5: Clair = 1: End Select
Select Case Coul.EThéoMax - Coul.E: Case Is > 400: Foncé = 2: Case Is > 62.5: Foncé = 1: End Select
If Foncé > 0 Or Clair > 0 Then NomCouleur = NomCouleur & " " & Choose(Clair * 3 + Foncé, "foncé", "très foncé", _
"clair", "délavé", "foncé délavé", "très clair", "clair délavé", "très délavé")
End If
Mid$(NomCouleur, 1, 1) = UCase(Left$(NomCouleur, 1))
End Function