Microsoft Office Forums - View Single Post

Guessed · 12-17-2018, 08:26 PM

I think you are looking for a luminance value along the lines of https://stackoverflow.com/questions/...s-of-rgb-color

Expanding on that idea and making use of a function found here https://stackoverflow.com/questions/...color-property the basic concept with workings are...

Code:

Sub ShowLuminance()
  Dim iR As Long, iG As Long, iB As Long, Colour As Long, iColour As Long
  Dim rng As Range, cel As Range, Cel2 As Range, FirstAddress As String
  Dim sRGB As String
  
  Set rng = Worksheets("SHEET1").Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row)
  For Each cel In rng
    sRGB = Color(cel)
    cel.Offset(0, 1).Value = sRGB
    cel.Offset(0, 2).Value = Luminance(sRGB)
    If cel.Offset(0, 2).Value > 128 Then
      cel.Font.Color = RGB(0, 0, 0)
    Else
      cel.Font.Color = RGB(255, 255, 255)
    End If
  Next
End Sub

Function Color(rng As Range, Optional formatType As Integer = 2) As Variant
  Dim colorVal As Variant
  colorVal = Cells(rng.Row, rng.Column).Interior.Color
  Select Case formatType
    Case 1
      Color = Hex(colorVal)
    Case 2
      Color = (colorVal Mod 256) & "," & ((colorVal \ 256) Mod 256) & "," & (colorVal \ 65536)
    Case 3
      Color = Cells(rng.Row, rng.Column).Interior.ColorIndex
    Case Else
      Color = colorVal
  End Select
  
End Function

Function Luminance(str) As Long
  Dim iR As Integer, iG As Integer, iB As Integer, iRGB As Variant
  iRGB = Split(str, ",")
  Luminance = (0.299 * iRGB(0) + 0.587 * iRGB(1) + 0.114 * iRGB(2))
End Function