Excel VBA高级图表绘制: 在绘图区自定义绘图的坐标问题

创建新图表时，首先要搞清楚坐标系，因为图表绘制在坐标系中。特别是用Excel编程绘制点、线、面和文本等基本图形元素时，它们是绘制在Shape对象对应的图表区中的，而不是绘在坐标系对应的绘图区中，所以需要进行坐标转换。[大谦Excel，dqexcel点com]

图表区和绘图区的位置和大小

第3章介绍了图表绘图区和图表区，绘图区是包围图表坐标系的最小矩形，图表区则是包围所有图表元素的最小矩形。

下面的代码用绿色矩形面绘制图表区。完整代码见：Samples->ch05 创建新图表->01 图表区的位置和大小->py.py。

code.vba

Sub CreateChart()
  Dim cht As Chart
  ActiveSheet.Range("A2:C11").Select
  Set cht = ActiveSheet.Shapes.AddChart2(-1, _
          xlColumnClustered, 200, 20, 350, 250, True).Chart
  'cht.SeriesCollection(1).Format.Fill.Patterned msoPatternDiagonalBrick
  'cht.SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(0, 0, 0)
  SetStyle cht, 0, 0.28
  Dim ca As ChartArea
  Set ca = cht.ChartArea    ‘获取图表区
  ca.Format.Fill.ForeColor.RGB = RGB(0, 255, 0)    ‘用绿色填充图表区
  ca.Format.Fill.Transparency = 0.5    ‘半透明
End Sub

运行代码生成图2-1。

\[\]

图2-1 图表区图2-2 绘图区

下面的代码用黄色矩形面绘制图表绘图区。完整代码见：Samples->ch05 创建新图表->02 绘图区的位置和大小->py.py。

code.vba

Sub CreateChart()
  Dim cht As Chart
  ActiveSheet.Range("A2:C11").Select
  Set cht = ActiveSheet.Shapes.AddChart2(-1, _
          xlColumnClustered, 200, 20, 350, 250, True).Chart
  SetStyle cht, 0, 0.28
  Dim pa As PlotArea
  Set pa = cht.PlotArea    ‘获取绘图区
  pa.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)    ‘用黄色填充绘图区
  pa.Format.Fill.Transparency = 0.5    ‘半透明
End Sub

运行代码生成图2-2。可见，绘图区和图表区的差别很明显。图表本身绘制在绘图区。

需要注意的是，引用绘图区的位置和大小时有两套属性，即Left, Top, Width和Height，以及InsideLeft, InsideTop, InsideWidth和InsideHeight。使用这两套属性绘制矩形面时会得到不同的结果。

下面的代码用第1套属性的值绘制绘图区。完整代码见：Samples->ch05 创建新图表->03 绘图区的位置和大小2->py.py。

code.vba

Sub CreateChart()
  Dim cht As Chart
  ActiveSheet.Range("A2:C11").Select
  Set cht = ActiveSheet.Shapes.AddChart2(-1, _
          xlColumnClustered, 200, 20, 350, 250, True).Chart
  SetStyle cht, 0, 0.28
  Dim pa As PlotArea
  Set pa = cht.PlotArea    ‘绘制绘图区矩形1
  pa.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)    ‘用橙色填充矩形1
  pa.Format.Fill.Transparency = 0.5    ‘半透明
End Sub

运行代码生成图2-3。可见，使用第1套属性值绘制的绘图区包含了坐标轴。

\[\]

图2-3 包含坐标轴的绘图区图2-4 不包含坐标轴的绘图区

下面的代码用第2套属性的值绘制绘图区。完整代码见：Samples->ch05 创建新图表->04 绘图区的位置和大小3->py.py。

code.vba

Sub CreateChart()
  Dim cht As Chart
  ActiveSheet.Range("A2:C11").Select
  Set cht = ActiveSheet.Shapes.AddChart2(-1, _
          xlColumnClustered, 200, 20, 350, 250, True).Chart
  SetStyle cht, 0, 0.28
  Dim pa As PlotArea
  Set pa = cht.PlotArea
  pa.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
  pa.Format.Fill.Transparency = 0.5
End Sub

运行代码生成图2-4。

可见，使用第2套属性的值绘制的绘图区不包含坐标轴，这个区域正是图表绘制的区域。所以，后面进行坐标转换计算时用的是加了Inside前缀的这一套属性而不是第一套，否则计算会出错。

图表区和绘图区的坐标系

2.1.1小节介绍了图表区和绘图区的位置和大小的定义，以及它们的区别，下面进一步介绍两个区域的坐标系的区别。

如图2-5所示，图表区中的坐标系是固定的，是设备坐标系的一种。坐标系的原点位于图表区的左上角，横轴向右为正，纵轴向下为正。

\[\]

图2-5 图表区的坐标系

绘图区中的坐标系不是固定的，图2-6和图2-7演示了同一绘图区中的两种不同的坐标系。图2-6中的坐标系坐标原点在绘图区左下角，横轴向右为正，纵轴向上为正；图2-7中的坐标系坐标原点在绘图区右上角，横轴向左为正，纵轴向下为正。因为绘图区中的坐标系不是固定的，坐标原点的位置和坐标轴的方向可以自己定义，所以这种坐标系称为自定义坐标系，或者叫用户坐标系。第3章介绍坐标系时介绍了坐标轴交点位置的设置和坐标轴反向，请参阅。

\[\]

图2-6 绘图区的一种坐标系图2-7 绘图区的另外一种坐标系

创建空的坐标系

接下来创建一个空的坐标系，这个空坐标系的位置和大小必须是精确可知的，因为后面坐标转换需要用到这些数据。

3.4.3小节介绍了，使用数值轴对象的MinimumScale和MaximumScale属性可以读取或写入对应数据的最小值和最大值。但是仅限于数值轴，分类轴和序列轴没有这两个属性，无法准确知道它们在图表中对应的最小值和最大值。

所以，创建的这个空的坐标系的两个坐标轴必须都是数值轴。Excel图表类型中，散点图的坐标轴满足这个要求，所以指定图表类型为xlXYScatter。

下面的代码按照上面的要求创建一个空的坐标系。完整代码见：Samples->ch05 创建新图表->07 创建空的坐标系->py.py。

code.vba

Sub CreateChart()
  Dim shp As Shape
  Dim cht As Chart
  Set shp = ActiveSheet.Shapes.AddChart2(-1, xlXYScatter, 300, 20, 350, 220)
  Set cht = shp.Chart
  Dim ax1 As Axis
  Set ax1 = cht.Axes(1)
  Dim ax2 As Axis
  Set ax2 = cht.Axes(2)
  ax1.MinimumScale = 0
  ax1.MaximumScale = 7
  ax2.MinimumScale = 0.05
  ax2.MaximumScale = 0.35
  cht.SeriesCollection.NewSeries
  SetStyle cht
End Sub

运行代码生成图2-8。

\[\]

图2-8 创建一个空的坐标系

在图表绘图区添加图形元素

做完前面的准备工作后，开始尝试绘图。Excel中常见的绘图是在工作表中进行的，利用Worksheet对象的Shapes属性返回Shapes集合，然后利用该集合的一系列以Add打头的方法添加图形。比如用AddLine方法添加直线段，用AddShape方法添加矩形、圆和自选图形等，用AddLabel方法添加标签。

下面的代码在工作表中绘制一根绿色直线段和一个兰色矩形面。完整代码见：Samples->ch05 创建新图表->08 在Excel图表中绘制图形->py.py。

code.vba

Sub CreateChart()
  Dim shp As Shape
  Dim shp2 As Shape
  ‘在工作表上创建矩形
  Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 30, 300, 200)
  shp.Fill.Transparency = 0.5    ‘半透明
  Set shp2 = ActiveSheet.Shapes.AddLine(20, 35, 300, 200)    ‘在工作表上创建直线段
  shp2.Line.ForeColor.RGB = RGB(0, 255, 0)    ‘线的颜色
  shp2.Line.Weight = 3    ‘线的宽度
End Sub

运行代码生成图2-9。可见，本例绘制的图形是绘制在工作表上的。

\[\]

图2-9 在工作表中绘图

但创建图表时图形不能绘制在工作表上，而是绘制在图2-8所示的坐标系绘图区中。仔细研究文档后发现，Excel的Chart对象也有Shapes属性，同样可以利用它返回的Shapes集合提供的一系列Add打头的方法在图表中添加各种图形。

下面的代码创建一个空的Chart对象，并使用它的Shapes属性向坐标系中添加绿色直线段和兰色矩形面。完整代码见：Samples->ch05 创建新图表->09 在Excel图表中绘制图形2->py.py。

code.vba

Sub CreateChart()
  Dim shp As Shape
  Dim shp2 As Shape
  Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 30, 300, 200)
  shp.Fill.Transparency = 0.5
  Set shp2 = ActiveSheet.Shapes.AddLine(20, 35, 300, 200)
  shp2.Line.ForeColor.RGB = RGB(0, 255, 0)
  shp2.Line.Weight = 3
End Sub

运行代码生成图2-10。很明显，这不是我们想要的结果。绘制的图形并没有以指定的位置和大小呈现在绘图区坐标系中。

\[\]

图2-10 尝试在绘图区绘制图形

为什么会出现这样的偏差呢？反复试验后，笔者发现此时的图形其实是绘制在图表区坐标系中的，而不是在绘图区坐标系中绘制。2.1.2小节介绍了图表区坐标系和绘图区坐标系的差别。假设绘图区坐标系指定为图2-8中的形式，即坐标原点位于绘图区左下角，横轴向右为正，纵轴向上为正。为了正确绘图，需要对图形控制点在两个坐标系中的坐标进行转换。

坐标转换

对比图表区坐标系和图2-8所示的绘图区坐标系，不难发现，坐标转换需要处理的地方主要有三点，一个是坐标原点有平移，第二个是纵轴需要反向，第三个是两个坐标系的度量单位也是不一样的，图表坐标系中用磅为单位，绘图区坐标系中则自定义单位。

进行坐标转换时，给定的数据是绘图区坐标系中的坐标数据，需要将该坐标转换到图表坐标系用于绘图。下面定义shape_x函数和shape_y函数分别实现指定点x坐标和y坐标的转换。

对于给定的绘图区坐标系中的x坐标，计算它与原点的水平距离与横轴长度的比值，乘以绘图区宽度，再加上绘图区左边界的位置，即得到转换后在图表坐标系中的x坐标。

对于给定的绘图区坐标系中的y坐标，除了作上面的类似计算外，还要考虑坐标反向问题，所以要用绘图区的高度减去指定点在绘图区内的计算高度，再加上绘图区上边界。

shape_x函数和shape_y函数的代码如下所示。完整代码见：Samples->ch05 创建新图表->10 坐标变换->py.py。

code.vba

Function ShapeX(cht As Chart, dblChartX As Double) As Double
  '省略部分代码
End Function
Function ShapeY(cht As Chart, dblChartY As Double) As Double
  '省略部分代码
End Function

下面重新实现图2.1.4小节的绘图，不同的是，绘图之前先调用shape_x函数和shape_y函数进行图形控制点的坐标转换。

code.vba

Sub CreateChart()
  ‘…
  SetStyle cht
  cht.SeriesCollection.NewSeries
  Dim shp2 As Shape
  Dim x As Double
  Dim y As Double
  Dim w As Double
  Dim h As Double
  x = ShapeX(cht, 50)
  y = ShapeY(cht, 230)
  w = cht.PlotArea.InsideWidth / (ax1.MaximumScale - ax1.MinimumScale) * 300
  h = cht.PlotArea.InsideHeight / (ax2.MaximumScale - ax2.MinimumScale) * 200
  Set shp2 = cht.Shapes.AddShape(msoShapeRectangle, x, y, w, h)
  shp2.Fill.Transparency = 0.5
  Dim shp3 As Shape
  Dim x2 As Double
  Dim y2 As Double
  x = ShapeX(cht, 20)
  y = ShapeY(cht, 35)
  x2 = ShapeX(cht, 300)
  y2 = ShapeY(cht, 200)
  Set shp3 = cht.Shapes.AddLine(x, y, x2, y2)
  shp3.Line.ForeColor.RGB = RGB(0, 255, 0)
  shp3.Line.Weight = 3
End Sub

运行代码生成图2-11。这是我们需要的正确的绘图。

\[\]

图2-11 转换坐标后绘图

本页目录

图表区和绘图区的位置和大小

图表区和绘图区的坐标系

创建空的坐标系

在图表绘图区添加图形元素

坐标转换