四角形グラデーションテスト

テスト結果

以下テストコード

Sub 四角形グラデーションテスト()
    
    Dim r As Range
    Set r = ThisWorkbook.Worksheets("Sheet1").Range("A2")
    
    Do While r.Value <> ""
        With r.Interior
            .Pattern = xlPatternRectangularGradient '四角形
            
            With .Gradient
                'グラデーションの収束箇所(0～1)
                .RectangleTop = r.Offset(0, 1).Value
                .RectangleLeft = r.Offset(0, 2).Value
                .RectangleRight = r.Offset(0, 3).Value
                .RectangleBottom = r.Offset(0, 4).Value
                
                'ColorStopsは収束箇所→外側(0～1)
                With .ColorStops
                    .Clear
                    .Add(0).Color = rgbWhite
'                    .Add(0.333).Color = rgbRed
'                    .Add(0.666).Color = rgbWhite
                    .Add(1).Color = rgbBlue
                End With
            End With
        End With
        
        Set r = r.Offset(1, 0)
    Loop
    
End Sub

ColorStops複数設定テスト

テスト（ｒｙ

Sub 虹テスト()
    
    Dim r As Range
    Set r = Selection
    
    With r.Interior
        .Pattern = xlPatternRectangularGradient '四角形
        
        With .Gradient
            'グラデーションの収束箇所(0～1)
            .RectangleTop = 0.45
            .RectangleLeft = 0.2
            .RectangleRight = 0.8
            .RectangleBottom = 0.55
            
            'ColorStopsは収束箇所→外側(0～1)
            With .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
                
                '虹②
                .Clear
                .Add(0).Color = rgbPurple
                .Add(0.166).Color = rgbIndigo
                .Add(0.333).Color = rgbBlue
                .Add(0.5).Color = rgbGreen
                .Add(0.666).Color = rgbYellow
                .Add(0.833).Color = rgbOrange
                .Add(1).Color = rgbRed
                
            End With
        End With
    End With
    
End Sub

以上。