オートシェイプの文字をグラデーション

何回か虹グラデーションを作って分かったけど、緑色をそのままrgbGreenで虹を作るとなんか美しくない。固定観念に囚われず好きな色で作るべし。

ちなみに虹が7色なのは日本と数国だけ、8色の国や2～6色の国もある。

文字のグラデーションをする際に0～1の範囲だと両端のグラデーションが見えない。0.3～0.7や0.25～0.75のように見える範囲で攻めるべし。テストすべし。

以下テストコード

Sub オートシェイプ文字グラデーションテスト()
    
    Dim myShape As Shape
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
'    For Each myShape In ws.Shapes
'        myShape.Delete
'    Next
    
    'オートシェイプ四角形/長方形
    Set myShape = ws.Shapes.AddShape(msoShapeRectangle, 0, 0, 180, 80)
    
    'テキスト情報
    With myShape.TextFrame2.TextRange
        .Text = "■Test"
        .Font.Size = 48
        .Font.Name = "ＭＳ Ｐゴシック"
        .Font.Bold = True
        .Font.Italic = True
        .Font.Fill.ForeColor.RGB = rgbBlack
    End With
    
    '外枠の有無
    'myShape.Line.ForeColor.RGB = rgbRed '赤枠
    myShape.Line.Visible = msoFalse '非表示
    
    '塗りつぶしの設定
    With myShape.Fill
        '.ForeColor.RGB = rgbWhite '塗りつぶし（白）
        .Visible = msoFalse '塗りつぶし無し
    End With
    
    'グラデーション情報追加
    With myShape.TextFrame2.TextRange.Font.Fill
        
        .OneColorGradient msoGradientHorizontal, 1, 1
        .GradientAngle = 90
        
        'GradientStopsは2個以下に出来ない。
        '自動生成された0と1を最後に削除した。
        With .GradientStops
            .Insert rgbRed, 0.3
            .Insert rgbOrange, 0.35
            .Insert rgbYellow, 0.4
            .Insert rgbLime, 0.45
            .Insert rgbGreen, 0.5
            .Insert rgbBlue, 0.55
            .Insert rgbIndigo, 0.6
            .Insert rgbBlueViolet, 0.65
            .Insert rgbPurple, 0.7
            .Delete 1
            .Delete 1
        End With
        
'        With .GradientStops
'            .Insert rgbRed, 0.3
'            .Insert rgbRed, 0.35
'            .Insert rgbOrange, 0.36
'            .Insert rgbOrange, 0.41
'            .Insert rgbYellow, 0.42
'            .Insert rgbYellow, 0.47
'            .Insert rgbGreen, 0.48
'            .Insert rgbGreen, 0.52
'            .Insert rgbBlue, 0.53
'            .Insert rgbBlue, 0.58
'            .Insert rgbIndigo, 0.59
'            .Insert rgbIndigo, 0.64
'            .Insert rgbPurple, 0.65
'            .Insert rgbPurple, 0.7
'            .Delete 1
'            .Delete 1
'        End With
        
    End With
    
    Set myShape = Nothing
    
End Sub

以上。