Option Explicit
'Hue:色相(色そのもの),Saturation:彩度(鮮やかさ),Brightness:明度(明暗の度合い)
'★★★ RGB→HSB変換 ★★★
'このコードは、「Windowsプログラミング研究所」
'http://www13.plala.or.jp/kymats/
'http://www13.plala.or.jp/kymats/study/gazou/HSB/HSB.html
'http://www13.plala.or.jp/kymats/program/HSB/HSB.cpp
'を、使わせていただいています。
Public Stime As Variant
Public Etime As Variant
Sub HSB色作成()
Dim 色(6) As Integer
Dim 赤 As Integer
Dim 緑 As Integer
Dim 青 As Integer
Dim 最大 As Long
Dim 最小 As Integer
Dim ステップ As Integer
Dim 色相 As Integer
Dim 彩度 As Integer
Dim 明度 As Integer
Dim 処理行 As Integer
Dim 段階 As Integer
Dim 合致(3) As Integer
Dim 色相出 As Integer
Dim 彩度出 As Integer
Dim 明度出 As Integer
Dim 赤16 As String
Dim 緑16 As String
Dim 青16 As String
Stime = Now()
' 処理を高速化するため、画面描画停止、自動計算停止
Application.ScreenUpdating = False
'216用のRGBの「とびとび」の値を取得
Worksheets("216色パレット").Activate
For 段階 = 1 To 6
色(段階) = Range("A6").Cells(段階, 1).Value
Next 段階
Worksheets("HSB色作成").Activate
'前回の処理結果の行を、前もって削除
Range(Range("B8"), Range("B8").End(xlDown)).Select
'セルB8から、B列の最後まで、行削除
Selection.EntireRow.Delete
Range("B7").Select
'指定パラメータを読み込み
ステップ = Range("B7").Value
彩度 = Range("C7").Value
明度 = Range("D7").Value
'メイン処理
処理行 = 1
For 色相 = 0 To 360 Step ステップ
Erase 合致
最大 = 明度
最小 = 最大 - 彩度 * 最大 / 255
If 色相 < 60 Then
赤 = 最大
緑 = 最小 + 色相 * (最大 - 最小) / 60
青 = 最小
ElseIf 色相 < 120 Then
赤 = 最大 - (色相 - 60) * (最大 - 最小) / 60
緑 = 最大
青 = 最小
ElseIf 色相 < 180 Then
赤 = 最小
緑 = 最大
青 = 最小 + (色相 - 120) * (最大 - 最小) / 60
ElseIf 色相 < 240 Then
赤 = 最小
緑 = 最大 - (色相 - 180) * (最大 - 最小) / 60
青 = 最大
ElseIf 色相 < 300 Then
赤 = 最小 + (色相 - 240) * (最大 - 最小) / 60
緑 = 最小
青 = 最大
Else '色相 < 360
赤 = 最大
緑 = 最小
青 = 最大 - (色相 - 300) * (最大 - 最小) / 60
End If
Range("B8").Cells(処理行, 1).Value = 色相
Range("C8").Cells(処理行, 1).Value = 彩度
Range("D8").Cells(処理行, 1).Value = 明度
Range("E8").Cells(処理行, 1).Interior.Color = RGB (赤, 緑, 青)
Range("F8").Cells(処理行, 1).Value = 赤
Range("G8").Cells(処理行, 1).Value = 緑
Range("H8").Cells(処理行, 1).Value = 青
If Len(Hex (赤)) = 1 Then
赤16 = "0" & Hex(赤)
Else
赤16 = Hex(赤)
End If
If Len(Hex(緑)) = 1 Then
緑16 = "0" & Hex(緑)
Else
緑16 = Hex(緑)
End If
If Len(Hex(青)) = 1 Then
青16 = "0" & Hex(青)
Else
青16 = Hex(青)
End If
Range("M8").Cells(処理行, 1).Value _
= "#" & 赤16 & 緑16 & 青16
'生成した色が、216色パレットに有るかどうかチェック
For 段階 = 1 To 6
If 色(段階) = 赤 Then 合致(1) = 1
If 色(段階) = 緑 Then 合致(2) = 1
If 色(段階) = 青 Then 合致(3) = 1
Next 段階
If 合致(1) * 合致(2) * 合致(3) = 1 Then
Range("I7").Cells(処理行, 1).Value = "216パレット色"
End If
'上のHSBからRGBへの変換が正しくできているか確認するため、
'RGBからHSBに逆変換して、同じ値になるかチェックする。
Call RGB→HSB(赤, 緑, 青, 色相出, 彩度出, 明度出)
Range("J8").Cells(処理行, 1).Value = 色相出
Range("K8").Cells(処理行, 1).Value = 彩度出
Range("L8").Cells(処理行, 1).Value = 明度出
処理行 = 処理行 + 1
Next 色相
' 画面描画再開、自動計算停止解除
Application.ScreenUpdating = True
Etime = Now()
MsgBox "処理が終了しました。" & Chr(13) & "処理時間は、" _
& Format(Etime - Stime, "nn分ss秒") & " でした。", vbOKOnly
End Sub