Excel VBA 色操作

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