【VBA】文字色やセル色に文字を埋め込む（抽出編）

Public Sub 文字列を抽出する()
    Dim txt As String
    Dim r As Long
    Dim lngRGB As Long
    
    r = 1
    txt = ""
    Do
        txt = txt & decodeChar(Cells(r, 1).Font.Color)
        txt = txt & decodeChar(Cells(r, 1).Interior.Color)
        r = r + 1
    Loop Until Cells(r, 1).Font.Color = rgb(0, 0, 0)
    
    MsgBox txt

End Sub

'RGBの値を16進表記に変換して、赤、緑、青に分解した値を
'再度10進数に変換し、それをアスキーコードとして文字に変換
Private Function decodeChar(ByVal lngRGB As Long) As String
    Dim res As String
    Dim strHex As String
    
    strHex = Right("000000" & Hex(lngRGB), 6)
    
    res = code2char(CLng("&H" & Right(strHex, 2)))
    res = res & code2char(CLng("&H" & Mid(strHex, 3, 2)))
    res = res & code2char(CLng("&H" & Left(strHex, 2)))
    
    decodeChar = res
End Function

Private Function code2char(ByVal ascCode As Long) As String
    If ascCode = 0 Or ascCode = 255 Then
        code2char = ""
    Else
        code2char = Chr(ascCode)
    End If
End Function