VBA轻松实现多色渐变填充

无论是在Excel还是在PowerPoint中，经常需要使用渐变色填充，但是如何使用VBA实现渐变色填充呢？大家肯定会想到录制宏，接下来就测试一下，录制宏是否能够继续让旗开得胜。
开始录制宏，然后在工作表中插入正方形，设置为红色到蓝色的渐变色（为了便于演示选择反差大的颜色），停止录制宏。

按【Alt+F11】组合键打开VBE，查看代码如下，看着还不错，一堆设置颜色代码。

Sub 宏1()
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 8.25, 10.5, 101.25, 101.25). _
        Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .BackColor.RGB = RGB(255, 255, 255)
        .TwoColorGradient msoGradientHorizontal, 1
    End With
    Selection.ShapeRange.Fill.Visible = msoTrue
End Sub

新建一个工作表，测试一下录制代码的效果，为啥是这个结果，和上面的图完全不是一回事。不得不说，录制宏在这个场景中无能为力。

那是不是就可以断定VBA没法干这个活呢？当然不是，VBA还算是个接近“万能”的老古董， 能够轻松实现渐变色的效果，增加点儿难度，设置如下图所示的三色渐变（红–绿--蓝）。

示例代码如下。

Sub ThreeGradients()
    Dim objShpFill As FillFormat
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 20, 20, 90, 90).Select
    Set objShpFill = Selection.ShapeRange.Fill
    With objShpFill
        .ForeColor.RGB = RGB(255, 0, 0)
        .OneColorGradient msoGradientHorizontal, 1, 1
        .GradientStops.Insert RGB(0, 255, 0), 0.5
        .GradientStops.Delete (2)
        .GradientStops.Insert RGB(0, 0, 255), 1
        Debug.Print .GradientStops.Count
    End With
    Set objShpFill = Nothing
End Sub

【代码解析】

第3行代码在指定位置插入正方形Shape对象，并选中，效果如下图所示。对象的填充颜色与Excel的默认颜色有关，大家在自己的电脑中运行代码时，颜色可能和下图不一致，但是不影响整个代码过程的最终效果。

第4行代码将Fill对象保存在变量中，以便于后续引用。
第6行代码设置填充色为红（渐变色中的第一个颜色），效果如下图所示。

第7行代码设置渐变色，效果如下图所示，虽然OneColorGradient看似单色渐变，但是效果是红色到白色的渐变效果。

查看形状格式设置，可以看到在100%位置添加了“白色”渐变光圈，注意：这将影响后续代码的效果。

第8行代码在50%位置（第2个参数0.5）添加“绿色”渐变光圈，效果如下图所示，不难看出正方形最下端仍然为白色。

第9行代码删除第2个渐变光圈（白色），效果如下图所示，大家可以对比一下上图，正方形最下端颜色变为绿色。

第10行代码插入新的蓝色渐变光圈，最终效果如下图所示。如果没有第9行代码，此代码执行之后没有任何效果，也就是说无法在已经设置渐变光圈的位置（100%位置）再次设置新的渐变光圈颜色。

第11行代码检查当前渐变光圈的数量，结果为3。

第13行代码释放对象变量所占用的系统资源。

---

如果需要更多种颜色的渐变效果，只需要继续在指定位置增加渐变光圈即可，删除第2个渐变光圈的代码只需执行一次。