つらつら Excel VBA

私の備忘録です。

背景色の線グラデーション

背景色を装飾する。グラデーションだけど、ぼかしは極力抑えました。グラデーションとは...?
f:id:tanaka0:20220416132813p:plain

Sub 線グラデーションテスト()
    Call FillStripeColor(range("A1"), rgbWhite, rgbBlue, 45, 2)
    Call FillStripeColor(range("B1"), rgbWhite, rgbGreen, 135, 2)
    Call FillStripeColor(range("A2"), rgbWhite, rgbBrown, 315, 2)
    Call FillStripeColor(range("B2"), rgbWhite, rgbRed, 225, 2)
    Call FillStripeColor(range("A3:A3"), rgbBlack, rgbYellow, 10, 7) 'トラ模様1
    Call FillStripeColor(range("A4:B4"), rgbYellow, rgbBlack, 10, 7) 'トラ模様2
End Sub

'背景を線グラデーションで装飾
'TargetRange:対象セル範囲
'Color1:色1、RGB(255,255,255)形式でも指定可
'Color2:色2
'Angle:角度(0~360度)
'LineCount:分割数
Private Sub FillStripeColor(TargetRange As range, Color1 As Long, Color2 As Long, Angle As Integer, LineCount As Integer)
    
    Dim i As Long, setColor As Long
    Dim startSpan As Double
    Dim endSpan As Double
    
    '境目のぼかし具合調整。
    'blurBorderは1 / LineCountより小さいこと。
    Dim blurBorder As Double
    blurBorder = (1 / LineCount) / 20
    
    With TargetRange.Interior
        .Pattern = xlPatternLinearGradient '線グラデーション
        .Gradient.Degree = Angle '角度指定
        With .Gradient.ColorStops
            .Clear
            
            For i = 1 To LineCount
                
                '交互に色をセット
                setColor = IIf(i Mod 2 = 1, Color1, Color2)
                
                '範囲計算
                Select Case i
                Case 1
                    startSpan = 0
                    endSpan = 1 / LineCount
                Case LineCount
                    startSpan = endSpan + blurBorder
                    endSpan = 1
                Case Else
                    startSpan = endSpan + blurBorder
                    endSpan = (1 / LineCount) * i
                End Select
                
                '設定
                With .Add(startSpan)
                    .Color = setColor
                    '.TintAndShade = 0 '背景の明度(-1~1)
                End With
                With .Add(endSpan)
                    .Color = setColor
                    '.TintAndShade = 0
                End With
                
                'デバッグ用
                'Debug.Print i & ", " & startSpan & "~" & endSpan & ", 色=" & setColor
                
            Next
            
        End With
    End With
End Sub

ぼかし具合部分を調整するとこうなる。一部できてない(笑)
f:id:tanaka0:20220416132826p:plain

以上。