Excel VBA 40 ExccelでA2とA2セルの色を10段階のグラデに

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

Sub GradientFill()

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 i As Integer

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

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

' A1とA2の塗りつぶし色を取得

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

' 色の変化量を計算

stepR = (r2 - r1) / 10

stepG = (g2 - g1) / 10

stepB = (b2 - b1) / 10

' B1〜B10にグラデーションを適用

For i = 1 To 10

newR = r1 + stepR * i

newG = g1 + stepG * i

newB = b1 + stepB * i

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

Next i

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

        vbInformation

End Sub

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

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