VBA实战技巧22：调整XY图表缩放比例以获取正确的宽高比

目标：想要调整XY（散点图）图表，以使两个轴的单位坐标轴值具有相同的比例。也就是说，需要调整图1中的图表，以便成为如图2所示的正方形和圆形。

图1：开始时是椭圆形和长方形

图2：调整为圆形和正方形

解决方案：

下面的代码可以处理嵌入式图表和图表工作表。在运行代码之前，确保选择了图表或者图表工作表是当前工作表。

Sub ScalePlot()

Dim Cht As Chart, Ser As Series, AxX As Axis, AxY As Axis

Dim XVals, YVals, MinX, MinY, MaxX, MaxY

Dim i

Dim PWd, PHt, PWd1, PHt1

Dim XDiff, YDiff, XDiff1, YDiff1

Dim Buffer

Dim WdScale, HtScale

Set Cht = ActiveChart

With Cht

'遍历所有系列确定MinX,MinY,MaxX,MaxY

For i = 1 To Cht.SeriesCollection.Count

Set Ser = Cht.SeriesCollection(i)

XVals = Ser.XValues

YVals = Ser.Values

If i = 1 Then

MinX = WorksheetFunction.Min(XVals)

MaxX =WorksheetFunction.Max(XVals)

MinY =WorksheetFunction.Min(YVals)

MaxY =WorksheetFunction.Max(YVals)

Else

MinX =WorksheetFunction.Min(MinX, XVals)

MaxX =WorksheetFunction.Max(MaxX, XVals)

MinY =WorksheetFunction.Min(MinY, YVals)

MaxY =WorksheetFunction.Max(MaxY, YVals)

End If

Next

'最大化绘图区域并获取其尺寸

With .PlotArea

.Top = 0

.Left = 0

.Width = Cht.ChartArea.Width

.Height = Cht.ChartArea.Height

PWd = .Width

PHt = .Height

PWd1 = .InsideWidth

PHt1 = .InsideHeight

End With

Set AxX = .Axes(xlCategory)

Set AxY = .Axes(xlValue)

'X和Y值的范围

XDiff = MaxX - MinX

YDiff = MaxY - MinY

'对XDiff和YDiff设置10%的缓冲空间,以便在系列边缘和绘图区之间有空白

Buffer = 0.1

'调整Max/MinX/Y的值

MaxX = MaxX + Buffer * XDiff

MinX = MinX - Buffer * XDiff

MaxY = MaxY + Buffer * YDiff

MinY = MinY - Buffer * YDiff

'修正X和Y值的范围

XDiff = MaxX - MinX

YDiff = MaxY - MinY

'重新缩放坐标轴以获得最大可能的放大倍率

With AxX

.MaximumScale = MaxX

.MinimumScale = MinX

End With

With AxY

.MaximumScale = MaxY

.MinimumScale = MinY

End With

'计算绘图区单位X和Y的比例

WdScale = PWd1 / XDiff

HtScale = PHt1 / YDiff

If WdScale > HtScale Then

'X轴需要调整

'保持Y轴比例不变

XDiff1 = (XDiff * WdScale / HtScale- XDiff) / 2

AxX.MinimumScale = MinX - XDiff1

AxX.MaximumScale = MaxX + XDiff1

Else

'Y轴需要调整

'保持X轴比例不变

YDiff1 = (YDiff * HtScale / WdScale- YDiff) / 2

AxY.MinimumScale = MinY - YDiff1

AxY.MaximumScale = MaxY + YDiff1

End If

End With

End Sub

图2所示的示例图表绘制了一个半径为4的圆，圆心是(5,5)，长为8的正方形，左上角坐标是(4.5,12)。

在x和y数据具有相似数量级的情况下（例如，当绘制形状而不是代数函数时），会出现此问题。通常，创建此类图表时，x和y轴的比例不同。绘图区域的高度和宽度也助于绘制序列的失真程度。这里的想法是确定需要将两个轴中的哪个轴设置为最小/最大比例值的更大范围，以便以正确的宽高比显示系列，也便于计算所需的最小/最大比例值，从而相应地设置坐标轴比例。

下面的代码段遍历图表中所有系列来计算最小/最大的x和y：

For i = 1 To Cht.SeriesCollection.Count

Set Ser = Cht.SeriesCollection(i)

XVals = Ser.XValues

YVals = Ser.Values

If i = 1 Then

MinX = WorksheetFunction.Min(XVals)

MaxX = WorksheetFunction.Max(XVals)

MinY = WorksheetFunction.Min(YVals)

MaxY = WorksheetFunction.Max(YVals)

Else

MinX = WorksheetFunction.Min(MinX,XVals)

MaxX = WorksheetFunction.Max(MaxX,XVals)

MinY = WorksheetFunction.Min(MinY,YVals)

MaxY = WorksheetFunction.Max(MaxY,YVals)

End If

Next

下面的代码将绘图区域最大化到图表边界，并获取绘图区域的内部尺寸（这些尺寸对进行缩放是必需的）：

With .PlotArea

.Top = 0

.Left = 0

.Width = Cht.ChartArea.Width

.Height = Cht.ChartArea.Height

PWd = .Width

PHt = .Height

PWd1 = .InsideWidth

PHt1 = .InsideHeight

End With

下一段代码计算极限x和y值的范围：

'X和Y值的范围

XDiff = MaxX -MinX

YDiff = MaxY -MinY

'对XDiff和YDiff设置10%的缓冲空间,以便在系列边缘和绘图区之间有空白

Buffer = 0.1

'调整Max/MinX/Y的值

MaxX = MaxX +Buffer * XDiff

MinX = MinX -Buffer * XDiff

MaxY = MaxY +Buffer * YDiff

MinY = MinY -Buffer * YDiff

'修正X和Y值的范围

XDiff = MaxX -MinX

YDiff = MaxY -MinY

'重新缩放坐标轴以获得最大可能的放大倍率

With AxX

.MaximumScale = MaxX

.MinimumScale = MinX

End With

With AxY

.MaximumScale= MaxY

.MinimumScale = MinY

End With

将x和y范围的10％的缓冲设置为在绘图区域内适当地容纳该系列，重新计算范围（包括缓冲区），并将轴的最小/最大比例设置为新计算的最小/最大值。

代码的最后一部分针对修改后的x和y范围计算绘图区域内部尺寸的新缩放比例：

'计算绘图区单位X和Y的比例

WdScale = PWd1/ XDiff

HtScale = PHt1/ YDiff

If WdScale> HtScale Then

'X轴需要调整

'保持Y轴比例不变

XDiff1 = (XDiff * WdScale / HtScale -XDiff) / 2

AxX.MinimumScale = MinX - XDiff1

AxX.MaximumScale = MaxX + XDiff1

Else

'Y轴需要调整

'保持X轴比例不变

YDiff1 = (YDiff * HtScale / WdScale -YDiff) / 2

AxY.MinimumScale = MinY - YDiff1

AxY.MaximumScale = MaxY + YDiff1

End If

如果水平缩放比例大于垂直缩放比例，则需要将x轴设置为更大的缩放比例范围（XDiff1），该范围是根据绘图区域内部宽度的水平缩放比例计算得出的。XDiff1对称地应用于x轴缩放比例（即，x轴的最小缩放比例减少XDiff1/2），最大缩放比例增加相同的量。如果垂直缩放比例大于水平缩放比例，则对y轴执行相同的操作。

小结：该解决方案中的代码以编程方式调整了一个散点图，该散点图包含相似数量级系列，以显示正确比例的系列。

注：本文学习整理自mrexcel.com，供有兴趣的朋友参考。