Excel VBA 41 ExccelでA2とA2セルの色を指定段階のグラデに

ExccelでA2とA2セルの色から指定した段階のグラデ—ションを作成します。

Sub GradientFillWithSteps()

Dim color1 As Long, color2 As Long

Dim r1 As Integer, g1 As Integer, b1 As Integer

Dim r2 As Integer, g2 As Integer, b2 As Integer

Dim stepCount As Integer

Dim i As Integer

Dim newR As Integer, newG As Integer, newB As Integer

Dim stepR As Double, stepG As Double, stepB As Double

' 塗りつぶし色を取得

color1 = Range("A1").Interior.Color

color2 = Range("A2").Interior.Color

' RGB値を分解

r1 = color1 Mod 256

g1 = (color1 ¥ 256) Mod 256

b1 = (color1 ¥ 256 ¥ 256) Mod 256

r2 = color2 Mod 256

g2 = (color2 ¥ 256) Mod 256

b2 = (color2 ¥ 256 ¥ 256) Mod 256

' 段階数を入力

stepCount = Application.InputBox("_

        段階数を入力してください（整数）:", Type:=1)

' 入力が無効な場合は終了

If stepCount <= 0 Then

MsgBox "有効な段階数を入力してください。", vbExclamation

Exit Sub

End If

' 色の変化量を計算

stepR = (r2 - r1) / stepCount

stepG = (g2 - g1) / stepCount

stepB = (b2 - b1) / stepCount

' B列にグラデーションを適用

Application.ScreenUpdating = False

For i = 1 To stepCount

newR = r1 + stepR * i

newG = g1 + stepG * i

newB = b1 + stepB * i

Range("B" & i).Interior.Color = RGB(newR, newG, newB)

Next i

Application.ScreenUpdating = True

MsgBox "グラデーションの塗りつぶしが完了しました！", _

        vbInformation

End Sub

A1とA2セルに基準となる塗りを行い、VBAを実行すると・・・

段階数を入力するパレットが表示されるので任意入力すれば・・・

指定段階段階の基準の色の間となる段階の塗りをB列に表示します。