修改已有图表创建新图表

也可以在已有Excel图表的基础上重新渲染图形元素或使用新的图形元素进行表现，从而创建新的图表。比如本节用单色或渐变色填充两条折线之间的区域，创建特殊的面积图。图2-37用单色填充两条折线之间的区域。[大谦Excel，dqexcel点com]

Document Image
\[\]

图2-37 用单色填充两条折线之间的区域

下面的代码实现图2-37。绘图的思路是用两条折线的数据点组合成一个封闭的多边形，然会绘制这个多边形。注意，组合时多边形的顶点要按逆时针方向排列。完整代码见：Samples->ch05 创建新图表->35 填充两条折线之间的区域->py.py。

code.vba 
Sub CreateChart()
  '省略部分代码
  Dim lngI As Long
  Dim data
  data = Range("A1:C100").Value
  Dim sngP(1 To 201, 1 To 2) As Single
  For lngI = 1 To 100
    sngP(lngI, 1) = ShapeX(cht, 100 - lngI + 1)
    sngP(lngI, 2) = ShapeY(cht, CDbl(data(100 - lngI + 1, 2)))
  Next
  For lngI = 101 To 200
    sngP(lngI, 1) = ShapeX(cht, lngI - 100)
    sngP(lngI, 2) = ShapeY(cht, CDbl(data(lngI - 100, 3)))
  Next
  sngP(201, 1) = sngP(1, 1)
  sngP(201, 2) = sngP(1, 2)
  Dim shp As Shape
  Set shp = cht.Shapes.AddPolyline(sngP)
  shp.Fill.ForeColor.RGB = RGB(76, 200, 132)
  shp.Line.Visible = False
  shp.Fill.Transparency = 0.3
End Sub

运行代码生成图2-37。

下面的代码实现图2-38。图中对两条折线顶点组成的多边形进行垂直渐变色填充。完整代码见：Samples->ch05 创建新图表->36 填充两条折线之间的区域2->py.py。

Document Image
\[\]

图2-38 用垂直渐变色填充两条折线之间的区域

code.vba 
Sub CreateChart2()
  '省略部分代码
  Dim lngI As Long
  Dim data
  data = Range("A1:C100").Value
  '画填充面
  Dim sngP(1 To 201, 1 To 2) As Single
  For lngI = 1 To 100
    sngP(lngI, 1) = ShapeX(cht, 100 - lngI + 1)
    sngP(lngI, 2) = ShapeY(cht, CDbl(data(100 - lngI + 1, 2)))
  Next
  For lngI = 101 To 200
    sngP(lngI, 1) = ShapeX(cht, lngI - 100)
    sngP(lngI, 2) = ShapeY(cht, CDbl(data(lngI - 100, 3)))
  Next
  sngP(201, 1) = sngP(1, 1)
  sngP(201, 2) = sngP(1, 2)
  Dim shp As Shape
  Set shp = cht.Shapes.AddPolyline(sngP)
  shp.Fill.ForeColor.RGB = RGB(255, 128, 0)
  shp.Fill.OneColorGradient msoGradientHorizontal, 1, 1
  shp.Fill.GradientStops.Insert RGB(0, 255, 0), 0.5
  shp.Fill.GradientStops.Delete 2
  shp.Fill.GradientStops.Insert RGB(0, 0, 255), 1
  shp.Line.Visible = False
  'shp.Fill.Transparency = 0.3
End Sub

运行代码生成图2-38。

下面的代码实现图2-39。图中对两条折线顶点组成的多边形进行水平渐变色填充。完整代码见：Samples->ch05 创建新图表->37 填充两条折线之间的区域3->py.py。

Document Image
\[\]

图2-39 用水平渐变色填充两条折线之间的区域

code.vba 
Sub CreateChart3()
  '省略部分代码
  Dim lngI As Long
  Dim data
  data = Range("A1:C100").Value
  Dim sngP(1 To 201, 1 To 2) As Single
  For lngI = 1 To 100
    sngP(lngI, 1) = ShapeX(cht, 100 - lngI + 1)
    sngP(lngI, 2) = ShapeY(cht, CDbl(data(100 - lngI + 1, 2)))
  Next
  For lngI = 101 To 200
    sngP(lngI, 1) = ShapeX(cht, lngI - 100)
    sngP(lngI, 2) = ShapeY(cht, CDbl(data(lngI - 100, 3)))
  Next
  sngP(201, 1) = sngP(1, 1)
  sngP(201, 2) = sngP(1, 2)
  Dim shp As Shape
  Set shp = cht.Shapes.AddPolyline(sngP)
  shp.Fill.ForeColor.RGB = RGB(0, 0, 255)
  shp.Fill.OneColorGradient msoGradientVertical, 1, 1
  shp.Fill.GradientStops.Insert RGB(0, 255, 0), 0.5
  shp.Fill.GradientStops.Delete 2
  shp.Fill.GradientStops.Insert RGB(255, 128, 0), 1
  shp.Line.Visible = False
  'shp.Fill.Transparency = 0.3
End Sub

运行代码生成图2-39。