きれいなグラデーションを作るにはセンスが必要！私には無理。
テスト結果
以下、テストコード
Sub 線グラデーションテスト()
With ActiveSheet.Range("A1").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 0
With .Gradient.ColorStops
.Clear
.Add(0).Color = rgbWhite
.Add(1).Color = rgbBlue
End With
End With
With ActiveSheet.Range("B1").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 180
With .Gradient.ColorStops
.Clear
.Add(0).Color = rgbWhite
.Add(1).Color = rgbBlue
End With
End With
With ActiveSheet.Range("A3").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
With .Gradient.ColorStops
.Clear
.Add(0).Color = rgbWhite
.Add(1).Color = rgbBlue
End With
End With
With ActiveSheet.Range("B3").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 630
With .Gradient.ColorStops
.Clear
.Add(0).Color = rgbWhite
.Add(1).Color = rgbBlue
End With
End With
With ActiveSheet.Range("A5").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 10
With .Gradient.ColorStops
.Clear
.Add(0.4).Color = vbWhite
.Add(0.8).Color = vbBlue
End With
End With
With ActiveSheet.Range("A6").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 0
With .Gradient.ColorStops
.Clear
.Add(0).Color = RGB(255, 255, 255)
.Add(0.2).Color = RGB(0, 0, 255)
.Add(0.4).Color = RGB(255, 255, 255)
.Add(0.6).Color = RGB(0, 0, 255)
.Add(0.8).Color = RGB(255, 255, 255)
.Add(1).Color = RGB(0, 0, 255)
End With
End With
With ActiveSheet.Range("A7").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 45
With .Gradient.ColorStops
.Clear
.Add(0).Color = &HFFFFFF
.Add(0.5).Color = &HFFFFFF
.Add(0.51).Color = &HFF0000
.Add(1).Color = &HFF0000
End With
End With
With ActiveSheet.Range("A8").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 45
With .Gradient.ColorStops
.Clear
.Add(0).Color = &HFFFFFF
.Add(0.5).Color = &HFFFFFF
.Add(0.5).Color = &HFF0000
.Add(1).Color = &HFF0000
End With
End With
With ActiveSheet.Range("A9").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 45
With .Gradient.ColorStops
.Clear
.Add(0).Color = &HFFFFFF
.Add(0.5).Color = &HFF0000
.Add(0.5).Color = &HFFFFFF
.Add(1).Color = &HFF0000
End With
End With
With ActiveSheet.Range("A10").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 5
With .Gradient.ColorStops
.Clear
.Add(0).Color = rgbRed
.Add(0.166).Color = rgbOrange
.Add(0.333).Color = rgbYellow
.Add(0.5).Color = rgbGreen
.Add(0.666).Color = rgbBlue
.Add(0.833).Color = rgbIndigo
.Add(1).Color = rgbPurple
End With
End With
With ActiveSheet.Range("A11").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 5
With .Gradient.ColorStops
.Clear
.Add(0).Color = rgbRed
.Add(0.142).Color = rgbRed
.Add(0.143).Color = rgbOrange
.Add(0.285).Color = rgbOrange
.Add(0.286).Color = rgbYellow
.Add(0.428).Color = rgbYellow
.Add(0.429).Color = rgbGreen
.Add(0.571).Color = rgbGreen
.Add(0.572).Color = rgbBlue
.Add(0.714).Color = rgbBlue
.Add(0.715).Color = rgbIndigo
.Add(0.857).Color = rgbIndigo
.Add(0.858).Color = rgbPurple
.Add(1).Color = rgbPurple
End With
End With
End Sub
Sub 背景色クリア()
Cells.Interior.ColorIndex = xlNone
Cells.Interior.Pattern = xlNone
End Sub
虹とか繰り返しの配色はコピペして使うことが考えられるので関数化してみた。
隣同士のセルでも違和感が無いよう同じ赤で囲むようにして、あれ？赤色だけ太くなるぞ、、、そりゃそうか。
角度をつけなければ違和感無いのでヨシ！
以下結果
以下（ｒｙ
Sub 関数化してみた()
Dim myArray
Dim r As range
myArray = Array(rgbRed, rgbOrange, rgbYellow, rgbGreen, rgbBlue, rgbIndigo, rgbPurple, rgbRed)
Set r = Range("A13:E13")
Call FillStripeColor2(r, 5, myArray)
myArray = Array(rgbRed, rgbOrange, rgbYellow, rgbGreen, rgbBlue, rgbIndigo, rgbPurple)
Set r = Range("A15:E15")
Call FillStripeColor2(r, 0, myArray)
myArray = Array(rgbYellow, rgbBlack, rgbYellow, rgbBlack, rgbYellow)
Set r = Range("A17:E17")
Call FillStripeColor2(r, 15, myArray)
End Sub
Private Sub FillStripeColor2(targetRange As range, Angle As Integer, colorArray)
Dim i As Long, setColor As Long
Dim startSpan As Double
Dim endSpan As Double
Dim LineCount As Integer
LineCount = UBound(colorArray) + 1
Dim blurBorder As Double
blurBorder = (1 / LineCount) / 200
With targetRange.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = Angle
With .Gradient.ColorStops
.Clear
For i = LBound(colorArray) To UBound(colorArray)
setColor = colorArray(i)
Select Case i
Case LBound(colorArray)
startSpan = 0
endSpan = 1 / LineCount
Case UBound(colorArray)
startSpan = endSpan + blurBorder
endSpan = 1
Case Else
startSpan = endSpan + blurBorder
endSpan = (1 / LineCount) * (i + 1)
End Select
.Add(startSpan).Color = setColor
.Add(endSpan).Color = setColor
Next
End With
End With
End Sub
以上。
