用基本图元搭建新图表

本页目录

2.2节介绍了点、线、面和文本等基本图形元素的创建，有了基本图形元素后，就可以用它们搭建新的图表了。本节结合若干实例进行介绍。[大谦Excel，dqexcel点com]

自定义堆叠柱状图

堆叠柱状图是复合柱状图的另外一种表现形式，它将每个分组中各序列的柱面从下往上依次堆叠，如图2-32所示。用Python xlwings可以用Shapes对象的AddChart2方法绘制堆叠柱状图，这里我们自己来创建该图。自定义绘制时，可以用矩形面绘制柱面，也可以用4条边的多边形绘制柱面。本例使用后一种方法，注意使用comtypes包实现多边形的绘制，参见2.2.4小节。

Document Image
\[\]

图2-32 自定义堆叠柱状图

下面定义draw_poly_4函数根据给定的顶点坐标和颜色绘制四边形小柱面。

code.vba 
Sub DrawPoly4(cht As Chart, pts() As Double, intR As Integer, intG As Integer, intB As Integer)
  Dim sngP(1 To 5, 1 To 2) As Single
  sngP(1, 1) = ShapeX(cht, pts(1, 1))
  sngP(1, 2) = ShapeY(cht, pts(1, 2))
  sngP(2, 1) = ShapeX(cht, pts(2, 1))
  sngP(2, 2) = ShapeY(cht, pts(2, 2))
  sngP(3, 1) = ShapeX(cht, pts(3, 1))
  sngP(3, 2) = ShapeY(cht, pts(3, 2))
  sngP(4, 1) = ShapeX(cht, pts(4, 1))
  sngP(4, 2) = ShapeY(cht, pts(4, 2))
  sngP(5, 1) = sngP(1, 1)
  sngP(5, 2) = sngP(1, 2)
  Dim shp As Shape
  Set shp = cht.Shapes.AddPolyline(sngP)
  shp.Fill.ForeColor.RGB = RGB(intR, intG, intB)
  'shp.Fill.Transparency = 0.5
  'shp.Line.ForeColor.RGB = RGB(intR, intG, intB)
  'shp.Line.Weight = 1.5
  shp.Line.Visible = False
End Sub

自定义堆叠柱状图，重点在于计算每个小柱面4个顶点的坐标。各顶点的x坐标很好计算，y坐标则需要根据各分组中每个序列的长度累加计算。下面的代码实现自定义堆叠柱状图。完整代码见：Samples->ch05 创建新图表->30 自定义堆叠柱状图->py.py。

code.vba 
Sub CreateChart()
  '省略部分代码
  cht.SeriesCollection.NewSeries
  Dim intI As Integer, intJ As Integer
  Dim dblSum As Double
  Dim dblPts(1 To 5, 1 To 2) As Double
  Dim intR(1 To 3) As Integer
  Dim intG(1 To 3) As Integer
  Dim intB(1 To 3) As Integer
  Dim data
  Dim dt(1 To 6, 1 To 4) As Double
  data = Range("A1:D6").Value
  For intI = 1 To 6
    dt(intI, 1) = 0’
  Next
  For intI = 1 To 6
    dblSum = 0
    For intJ = 2 To 4
      dblSum = dblSum + CDbl(data(intI, intJ))
      dt(intI, intJ) = dblSum
    Next
  Next
  intR(1) = 0: intG(1) = 176: intB(1) = 240
  intR(2) = 146: intG(2) = 208: intB(2) = 80
  intR(3) = 255: intG(3) = 192: intB(3) = 0
  For intI = 1 To 6
    For intJ = 1 To 3
      dblPts(1, 1) = intI - 0.25
      dblPts(1, 2) = dt(intI, intJ)
      dblPts(2, 1) = intI + 0.25
      dblPts(2, 2) = dt(intI, intJ)
      dblPts(3, 1) = intI + 0.25
      dblPts(3, 2) = dt(intI, intJ + 1)
      dblPts(4, 1) = intI - 0.25
      dblPts(4, 2) = dt(intI, intJ + 1)
      dblPts(5, 1) = dblPts(1, 1)
      dblPts(5, 2) = dblPts(1, 2)
      DrawPoly4 cht, dblPts, intR(intJ), intG(intJ), intB(intJ)
    Next
  Next
End Sub

运行代码生成图2-32。

自定义冲击图

冲击图如图2-33所示。在堆叠柱状图的基础上，冲击图将相邻分组之间间隔的区域进行了颜色填充。填充方式仍然是用相同序列的顶点围成的多边形使用对应序列的颜色进行填充，增加透明性。

Document Image
\[\]

图2-33 自定义冲击图

绘制冲击图的方法与2.3.1小节绘制自定义堆叠柱状图的方法一样，重点在于分组柱面之间各小四边形面顶点坐标的计算和四边形面的绘制。

下面的代码计算柱间多边形的顶点坐标，并调用draw_poly_4函数进行绘制。完整代码见：Samples->ch05 创建新图表->31 自定义冲击图->py.py。

code.vba 
Sub CreateChart()
  ‘…
  For intI = 1 To 6
    dt(intI, 1) = 0’
  Next
  For intI = 1 To 6
    dblSum = 0
    For intJ = 2 To 4
      dblSum = dblSum + CDbl(data(intI, intJ))
      dt(intI, intJ) = dblSum
    Next
  Next
  intR(1) = 0: intG(1) = 176: intB(1) = 240
  intR(2) = 146: intG(2) = 208: intB(2) = 80
  intR(3) = 255: intG(3) = 192: intB(3) = 0
  For intI = 1 To 6
    For intJ = 1 To 3
      dblPts(1, 1) = intI - 0.25
      dblPts(1, 2) = dt(intI, intJ)
      dblPts(2, 1) = intI + 0.25
      dblPts(2, 2) = dt(intI, intJ)
      dblPts(3, 1) = intI + 0.25
      dblPts(3, 2) = dt(intI, intJ + 1)
      dblPts(4, 1) = intI - 0.25
      dblPts(4, 2) = dt(intI, intJ + 1)
      dblPts(5, 1) = dblPts(1, 1)
      dblPts(5, 2) = dblPts(1, 2)
      DrawPoly4 cht, dblPts, intR(intJ), intG(intJ), intB(intJ), False
    Next
  Next
  For intI = 1 To 5
    For intJ = 1 To 3
      dblPts(1, 1) = intI + 0.25
      dblPts(1, 2) = dt(intI, intJ)
      dblPts(2, 1) = intI + 1 - 0.25
      dblPts(2, 2) = dt(intI + 1, intJ)
      dblPts(3, 1) = intI + 1 - 0.25
      dblPts(3, 2) = dt(intI + 1, intJ + 1)
      dblPts(4, 1) = intI + 0.25
      dblPts(4, 2) = dt(intI, intJ + 1)
      dblPts(5, 1) = dblPts(1, 1)
      dblPts(5, 2) = dblPts(1, 2)
      DrawPoly4 cht, dblPts, intR(intJ), intG(intJ), intB(intJ), True
    Next
  Next
End Sub

运行代码生成图2-33。

自定义散点柱状图

散点柱状图是常见的统计图表，它是简单柱状图和抖动散点图的组合图。该图用分组数据的均值向量绘制简单柱状图，用各分组原始数据绘制抖动散点图。所以，该图既能反映各分组数据的综述统计信息，也能反映原始数据的分布。因为Excel不能直接绘制抖动散点图，所以需要自己进行创建。

Document Image
\[\]

图2-34 自定义散点柱状图

本书中介绍了多种方法绘制散点柱状图，这里用多边形绘制柱状图，用2.2.1小节介绍的绘点的方法绘制抖动散点。第7章绘详细介绍抖动散点图的绘制。

下面用draw_bar函数绘制单个柱面。

code.vba 
Sub DrawBar(cht As Chart, dblY() As Double, lngN As Long, dblX As Double, intR As Integer, intG As Integer, intB As Integer, dblW As Double, bolGradient As Boolean)
  Dim dblMean As Double
  dblMean = Application.WorksheetFunction.Average(dblY)
  Dim sngP(1 To 5, 1 To 2) As Single
  sngP(1, 1) = ShapeX(cht, dblX - dblW / 2)
  sngP(1, 2) = ShapeY(cht, cht.Axes(2).MinimumScale)
  sngP(2, 1) = ShapeX(cht, dblX + dblW / 2)
  sngP(2, 2) = ShapeY(cht, cht.Axes(2).MinimumScale)
  sngP(3, 1) = ShapeX(cht, dblX + dblW / 2)
  sngP(3, 2) = ShapeY(cht, dblMean)
  sngP(4, 1) = ShapeX(cht, dblX - dblW / 2)
  sngP(4, 2) = ShapeY(cht, dblMean)
  sngP(5, 1) = sngP(1, 1)
  sngP(5, 2) = sngP(1, 2)
  Dim shp As Shape
  Set shp = cht.Shapes.AddPolyline(sngP)
  If bolGradient Then
    shp.Fill.BackColor.RGB = RGB(intR, intG, intB)
    shp.Fill.OneColorGradient msoGradientHorizontal, 1, 1
    shp.Line.ForeColor.RGB = RGB(intR, intG, intB)
    shp.Line.Weight = 1.5
  Else
    shp.Fill.ForeColor.RGB = RGB(intR, intG, intB)
    'shp.Fill.Transparency = 0.5
    shp.Line.ForeColor.RGB = RGB(intR, intG, intB)
    shp.Line.Weight = 1.5
  End If
End Sub

下面用draw_rnd_scatter函数绘制单个分组数据的抖动散点图。

code.vba 
Sub DrawRndScatter(cht As Chart, dblX As Double, dblY() As Double, lngN As Long, dblW As Double, intR As Integer, intG As Integer, intB As Integer)
  Dim dblRD() As Double
  ReDim dblRD(lngN)
  Dim intI As Integer
  For intI = 0 To lngN - 1
    Randomize
    dblRD(intI) = dblX - dblW / 2 + dblW * Rnd
  Next
  Dim x As Double
  Dim y As Double
  Dim w As Double
  Dim h As Double
  Dim shp As Shape
  For intI = 1 To lngN
    bx = ShapeX(cht, CDbl(dblRD(intI - 1)))
    by = ShapeY(cht, CDbl(dblY(intI - 1)))
    ex = cht.PlotArea.InsideWidth / (cht.Axes(1).MaximumScale - _
          cht.Axes(1).MinimumScale) * 0.09
    ey = ex
    Set shp2 = cht.Shapes.AddShape(9, bx, by, ex, ey)
    'shp2.Fill.Visible = False
    shp2.Fill.ForeColor.RGB = RGB(intR, intG, intB)
    shp2.Line.Weight = 1
    shp2.Line.ForeColor.RGB = RGB(intR, intG, intB)
  Next
End Sub

下面的代码根据分组变量对指定数据进行分组，然后利用分组数据绘制柱状图和抖动散点图，并一起组合成散点柱状图。完整代码见：Samples->ch05 创建新图表->32 自定义散点柱状图->py.py。

code.vba 
Sub Test()
  '省略部分代码
  If cht.SeriesCollection.Count > 0 Then
    For intI = cht.SeriesCollection.Count To 1 Step -1
      cht.SeriesCollection(intI).Delete
    Next
  End If
  ax1.CrossesAt = ax1.MinimumScale
  ax2.CrossesAt = ax2.MinimumScale
  SetStyle cht
  DrawBar cht, D1, intCount(1), 1, 76, 200, 132, 0.5, False
  DrawBar cht, D2, intCount(2), 2, 76, 200, 132, 0.5, False
  DrawBar cht, D3, intCount(3), 3, 76, 200, 132, 0.5, False
  DrawBar cht, D4, intCount(4), 4, 76, 200, 132, 0.5, False
  DrawBar cht, D5, intCount(5), 5, 76, 200, 132, 0.5, False
  DrawBar cht, D6, intCount(6), 6, 76, 200, 132, 0.5, False
  DrawRndScatter cht, 1, D1, intCount(1), 0.5, 192, 0, 0
  DrawRndScatter cht, 2, D2, intCount(2), 0.5, 255, 192, 0
  DrawRndScatter cht, 3, D3, intCount(3), 0.5, 146, 208, 80
  DrawRndScatter cht, 4, D4, intCount(4), 0.5, 0, 176, 80
  DrawRndScatter cht, 5, D5, intCount(5), 0.5, 0, 176, 240
  DrawRndScatter cht, 6, D6, intCount(6), 0.5, 0, 112, 192
  cht.SeriesCollection.NewSeries
  Dim intN As Integer
  intN = cht.SeriesCollection.Count
  cht.FullSeriesCollection(intN).ChartType = xlXYScatterLinesNoMarkers
  cht.FullSeriesCollection(intN).XValues = Array(0, 7)
  cht.FullSeriesCollection(intN).Values = Array(0.05, 0.05)
  cht.FullSeriesCollection(intN).Format.Line.ForeColor.RGB = RGB(0, 0, 0)
  cht.FullSeriesCollection(intN).Format.Line.Weight = 1
End Sub

运行代码生成图2-34。

自定义三角形柱状图

2.3.1小节和2.3.2小节用多边形绘制了四边形，这里用多边形绘制三角形，用三角形代替柱状图中的矩形柱面，并用渐变色填充三角形柱面，如图2-35所示。

Document Image
\[\]

图2-35 三角形柱状图

下面的代码实现三角形柱状图的绘制，并用渐变色对三角形进行填充。完整代码见：Samples->ch05 创建新图表->33 三角形柱状图->py.py。

code.vba 
Sub CreateChart()
  '省略部分代码
  cht.SeriesCollection.NewSeries
  Dim data
  data = Range("A2:B7").Value
  Dim intI As Integer
  Dim shp2 As Shape
  Dim sngP(1 To 4, 1 To 2) As Single
  For intI = 1 To 6
    sngP(1, 1) = ShapeX(cht, intI - 0.25)
    sngP(1, 2) = ShapeY(cht, 0)
    sngP(2, 1) = ShapeX(cht, intI + 0.25)
    sngP(2, 2) = ShapeY(cht, 0)
    sngP(3, 1) = ShapeX(cht, CDbl(intI))
    sngP(3, 2) = ShapeY(cht, CDbl(data(intI, 2)))
    sngP(4, 1) = sngP(1, 1)
    sngP(4, 2) = sngP(1, 2)
    Set shp2 = cht.Shapes.AddPolyline(sngP)
    shp2.Fill.ForeColor.RGB = RGB(255, 192, 0)
    shp2.Fill.TwoColorGradient msoGradientVertical, 1
    shp2.Fill.BackColor.RGB = RGB(240, 240, 240)
    'shp2.Line.Weight = 0.5
    shp2.Line.Visible = False
  Next
End Sub

运行代码生成图2-35。

自定义倒三角形柱状图

学术期刊中还可以看到图2-36所示的倒三角形柱状图。该图的绘制方法与三角形柱状图的类似，不同的是用多边形绘制倒三角形。

Document Image
\[\]

图2-36 倒三角形柱状图

下面的代码实现倒三角形柱状图的绘制，并用渐变色对三角形进行填充，添加数据标签。完整代码见：Samples->ch05 创建新图表->34 倒三角形柱状图->py.py。

triangle with gradient colors, and adding data labels.

code.vba 
Sub CreateChart()
  '省略部分代码
  cht.SeriesCollection.NewSeries
  Dim data
  data = Range("A2:B7").Value
  Dim intI As Integer
  Dim shp2 As Shape
  Dim shp3 As Shape
  Dim x As Double
  Dim y As Double
  Dim w As Double
  Dim h As Double
  Dim sngP(1 To 4, 1 To 2) As Single
  For intI = 1 To 6
    sngP(1, 1) = ShapeX(cht, intI - 0.25)
    sngP(1, 2) = ShapeY(cht, CDbl(data(intI, 2)))
    sngP(2, 1) = ShapeX(cht, CDbl(intI))
    sngP(2, 2) = ShapeY(cht, 0)
    sngP(3, 1) = ShapeX(cht, intI + 0.25)
    sngP(3, 2) = ShapeY(cht, CDbl(data(intI, 2)))
    sngP(4, 1) = sngP(1, 1)
    sngP(4, 2) = sngP(1, 2)
    Set shp2 = cht.Shapes.AddPolyline(sngP)
    shp2.Fill.ForeColor.RGB = RGB(255, 192, 0)
    shp2.Fill.TwoColorGradient msoGradientVertical, 1
    shp2.Fill.BackColor.RGB = RGB(240, 240, 240)
    'shp2.Line.Weight = 0.5
    shp2.Line.Visible = False
    x = ShapeX(cht, CDbl(intI - 0.35))
    y = ShapeY(cht, CDbl(data(intI, 2)) + 0.025)
    w = cht.PlotArea.InsideWidth / (ax1.MaximumScale - ax1.MinimumScale) * 1
    h = cht.PlotArea.InsideHeight / (ax2.MaximumScale - ax2.MinimumScale) * 0.04
    Set shp3 = cht.Shapes.AddLabel(1, x, y, w, h)
    shp3.TextFrame.Characters.Text = CStr(CDbl(data(intI, 2)))
    shp3.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
    shp3.TextFrame.Characters.Font.Size = 8
  Next
End Sub

运行代码生成图2-36。