ExccelでA2とA2セルの色から指定した段階の色相グラデ—ションを作成します。
Sub ApplyHueGradientToColumnB()
Dim ws As Worksheet
Dim startColor As Long, endColor As Long
Dim steps As Integer, i As Integer
Dim startHue As Single, endHue As Single
Dim startSaturation As Single, startBrightness As Single
Dim endSaturation As Single, endBrightness As Single
Dim h As Single, s As Single, b As Single
Set ws = ActiveSheet
startColor = ws.Range("A1").Interior.Color
endColor = ws.Range("A2").Interior.Color
steps = Application._
InputBox("ステップ数を入力してください:", Type:=1)
' RGBからHSBに変換
RGBtoHSB startColor, startHue, startSaturation, startBrightness
RGBtoHSB endColor, endHue, endSaturation, endBrightness
' グラデーションを適用
For i = 0 To steps
h = startHue + (endHue - startHue) * i / steps
s = startSaturation + _
(endSaturation - startSaturation) * i / steps
b = startBrightness + _
(endBrightness - startBrightness) * i / steps
ws.Cells(i + 3, 2).Interior.Color = HSBtoRGB(h, s, b) ' B列に適用
Next i
End Sub
' RGB を HSB に変換
Sub RGBtoHSB(ByVal rgbColor As Long, _
ByRef h As Single, ByRef s As Single, ByRef b As Single)
Dim r As Single, g As Single, bl As Single
Dim minVal As Single, maxVal As Single, delta As Single
r = (rgbColor Mod 256) / 255
g = ((rgbColor ¥ 256) Mod 256) / 255
bl = (rgbColor ¥ 65536) / 255
minVal = WorksheetFunction.Min(r, g, bl)
maxVal = WorksheetFunction.Max(r, g, bl)
delta = maxVal - minVal
b = maxVal ' 明度
If delta = 0 Then
h = 0
s = 0
Else
s = delta / maxVal ' 彩度
If maxVal = r Then
h = (g - bl) / delta
ElseIf maxVal = g Then
h = 2 + (bl - r) / delta
Else
h = 4 + (r - g) / delta
End If
h = h * 60
If h < 0 Then h = h + 360
End If
End Sub
' HSB を RGB に変換
Function HSBtoRGB(ByVal h As Single, _
ByVal s As Single, ByVal b As Single) As Long
Dim r As Single, g As Single, bl As Single
Dim i As Integer, f As Single, p As Single, q As Single, t As Single
If s = 0 Then
r = b: g = b: bl = b
Else
h = h / 60
i = Int(h)
f = h - i
p = b * (1 - s)
q = b * (1 - s * f)
t = b * (1 - s * (1 - f))
Select Case i Mod 6
Case 0: r = b: g = t: bl = p
Case 1: r = q: g = b: bl = p
Case 2: r = p: g = b: bl = t
Case 3: r = p: g = q: bl = b
Case 4: r = t: g = p: bl = b
Case 5: r = b: g = p: bl = q
End Select
End If
HSBtoRGB = RGB(Int(r * 255), Int(g * 255), Int(bl * 255))
End Function
A1とA2セルに基準となる塗りを行い、VBAを実行すると段階数を入力するパレットが表示されるので任意入力すれば・・・
指定段階段階の基準の色の間となる段階の塗りをB列に表示します。
