背景色RGBから見やすい前景色RGB（白黒）を取得する

kccFuncGraphics_partial.bas.vba

Attribute VB_Name = "kccFuncGraphics_partial"
Rem --------------------------------------------------------------------------------
Rem
Rem  @module        kccFuncGraphics_partial
Rem
Rem  @description   描画関係の関数群（モジュールからの抜粋）
Rem
Rem  @update        2024/04/28
Rem
Rem  @author        @KotorinChunChun (GitHub / Twitter)
Rem                 https://github.com/KotorinChunChun
Rem                 https://twitter.com/KotorinChunChun
Rem
Rem  @license       MIT (http://www.opensource.org/licenses/mit-license.php)
Rem
Option Explicit

Rem RGB変換の汎用関数
Public Function GetRedByRGB(ByVal RGBValue As Long) As Long
    GetRedByRGB = &HFF& And RGBValue
End Function

Public Function GetGreenByRGB(ByVal RGBValue As Long) As Long
    GetGreenByRGB = (&HFF00& And RGBValue) \ 256
End Function

Public Function GetBlueByRGB(ByVal RGBValue As Long) As Long
    GetBlueByRGB = (&HFF0000 And RGBValue) \ 65536
End Function

Function RgbByFFFFFF(FFFFFF As String)
    If Len(FFFFFF) <> 6 Then Err.Raise 9999, , "カラーコードが不正です"
    RgbByFFFFFF = Rgb(CLng("&H" & Left$(FFFFFF, 2)), _
                      CLng("&H" & Mid$(FFFFFF, 3, 2)), _
                      CLng("&H" & Right$(FFFFFF, 2)))
End Function

Rem RGB色データを16進数 FFFFFF に変換する
Rem   16進数化するとBGRになるので、RGBに逆転させる
Function RgbHex(rgb_color As Long) As String
    RgbHex = Right("000000" & Hex(rgb_color), 6)
    RgbHex = Right(RgbHex, 2) & Mid(RgbHex, 3, 2) & Left(RgbHex, 2)
End Function

Rem 背景色RGBから見やすい前景色RGB（白黒）を取得する
Rem
Rem W3Cで公開されているアルゴリズム参考
Rem https://www.w3.org/TR/AERT/#color-contrast
Function GetForeBlackOrWhiteByBackRGB(ByVal RGBValue As Long) As Long
    GetForeBlackOrWhiteByBackRGB = _
        GetForeBlackOrWhiteByBackRedGreenBlue( _
            GetRedByRGB(RGBValue), _
            GetGreenByRGB(RGBValue), _
            GetBlueByRGB(RGBValue))
End Function

Function GetForeBlackOrWhiteByBackRedGreenBlue(RgbR As Long, RgbG As Long, RgbB As Long) As Long
    Dim tf As Boolean
    tf = ((((RgbR * 299) + _
            (RgbG * 587) + _
            (RgbB * 114)) / 1000) < 128)
    GetForeBlackOrWhiteByBackRedGreenBlue = IIf(tf, Rgb(255, 255, 255), Rgb(0, 0, 0))
End Function

Sub Test_新しいブックに全ての色を出力()
    Workbooks.Add
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Application.ScreenUpdating = False
    ws.Range("A1:G1").Value = Array("Red", "Green", "Blue", "BackRGB", "BackHexRGB", "FontRGB", "FontHexRGB")
    ws.Columns("E").NumberFormatLocal = "@"
    ws.Columns("G").NumberFormatLocal = "@"
    ws.Columns.AutoFit
    Dim i As Long: i = 1
    Dim r, g, b
    For r = 0 To 255 Step 16
        For g = 0 To 255 Step 16
            For b = 0 To 255 Step 16
                i = i + 1
                With ws
                    .Cells(i, 1).Value = r
                    .Cells(i, 2).Value = g
                    .Cells(i, 3).Value = b
                    .Cells(i, 4).Value = Rgb(r, g, b)
                    .Cells(i, 5).Value = RgbHex(Rgb(r, g, b))
                    .Cells(i, 6).Value = GetForeBlackOrWhiteByBackRGB(Rgb(r, g, b))
                    .Cells(i, 7).Value = RgbHex(GetForeBlackOrWhiteByBackRGB(Rgb(r, g, b)))
                    
                    .Cells(i, 4).Interior.Color = Rgb(r, g, b)
                    .Cells(i, 4).Font.Color = GetForeBlackOrWhiteByBackRGB(Rgb(r, g, b))
                End With
            Next
        Next
    Next
End Sub

「Test_新しいブックに全ての色を出力」を実行すると、新しいExcelブックを開いたうえで全てのカラーの背景色と最適と判断した前景色の一覧が出力されます。

アルゴリズムにはW3Cの
https://www.w3.org/TR/AERT/#color-contrast
を使用しています。