Sub mkrgb()
Dim C, R, G, B
Set STARTCELL = Cells.Find("色サンプル", LookAt:=xlWhole).Offset(1, 0)
STARTCELL.Select
Do
'##文字色
'アクティブセル文字色を16進数の値で取得
C = Right("000000" & Hex(ActiveCell.Font.Color), 6)
ActiveCell.Offset(0, 1) = C
'アクティブセル文字色をRGBの値で取得
R = Val("&H" & Right(C, 2))
G = Val("&H" & Mid(C, 3, 2))
B = Val("&H" & Left(C, 2))
ActiveCell.Offset(0, 3) = R & "." & G & "." & B
'##背景色
'アクティブセル背景色を16進数の値で取得
C = Right("000000" & Hex(ActiveCell.Interior.Color), 6)
ActiveCell.Offset(0, 2) = C
'アクティブセル背景色をRGBの値で取得
R = Val("&H" & Right(C, 2))
G = Val("&H" & Mid(C, 3, 2))
B = Val("&H" & Left(C, 2))
ActiveCell.Offset(0, 4) = R & "." & G & "." & B
'##VTColor
'アクティブセル文字列、背景色のRGB値を結合して","区切りに
ActiveCell.Offset(0, 5) = Replace(ActiveCell.Offset(0, 3) & "," & _
ActiveCell.Offset(0, 4), ".", ",")
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
Range("A1").Select
End Sub
