Subroutine to force XY-chart to have equal scales
Subroutine to force XY-chart to have equal scales
(OP)
A few years ago, building heavily on work done by several others, I placed on this forum a VBA subroutine to force an Excel XY-chart to have equal scaling on its X ("Category" and Y ("Value") axes. See the now-closed discussion at thread770-274998: Forcing an Excel chart to have equal X & Y scales from June 2010. I have since made several further changes to this subroutine, the most important one being that it can now properly handle cases where the chart being rescaled is one of several embedded charts on a worksheet.
I attach the latest incarnation below. Use at your own risk.
I attach the latest incarnation below. Use at your own risk.
CODE
Sub GiveActivePlotEqualScales() ' ' PURPOSE ' ' Changes the X and Y scales of an Excel XY-Scatter chart by ' exactly the right amount to result in the two scales being equal. ' ' The chart, which can be embedded in a worksheet or can be on its ' own ChartSheet, has to be "active" when this subroutine runs. ' ' The subroutine will not run on a protected worksheet unless the ' protection allows the user to "edit objects". However a user who ' can "edit objects" can also mess up the plot in various ways, so ' the protection would seem to be somewhat pointless. ' ' HISTORY ' ' The original subroutine was developed by Jon Peltier, and placed ' on his PeltierTech website at URL ' www.peltiertech.com/Excel/Charts/SquareGrid.html ' where it was still accessible in September 2015. ' A modified version of the routine was placed on the "Engineering ' spreadsheets" forum of the Eng-Tips web site (www.Eng-Tips.com) ' by contributor Panars in December 2005, in thread 770-141275. ' Two other EngTip-ers, Electricpete and Denial then made some ' further modifications to it as the thread developed. ' ' In 2010 Denial posted an improved version on Eng-Tips. See ' thread 770-274998. The main problem fixed was that for ' charts with at least one axis displayed there were still some, ' seemingly random, circumstances under which the resulting scales ' would not be adequately equal. ' ' MODIFICATIONS SINCE MID 2015 ' ' Sep 2015. Correction for where a worksheet has more than one embedded ' chart object. (Previously chart object 1's series were used to ' calculate the scaling factors for all the chart objects.) ' Sep 2015. In charts where only one axis is utilised we now set that ' axis's MajorUnitsIsAuto parameter to True. This avoids some grossly ' inappropriate label spacings under some circumstances. ' 24Sep15. This updated version was posted on Eng-Tips. ' Dim s As Series, PointsList As Variant, PointCount As Long Dim PlotInHt As Double, PlotInWd As Double Dim HaveXaxis As Boolean, HaveYaxis As Boolean Dim PlotName As String, PlotNumb As Long Dim TypeOfPlot As Long, SubtypeOfPlot As Long Dim IsEmbedded As Boolean Dim Xmax As Double, Xmin As Double, Xdel As Double Dim Ymax As Double, Ymin As Double, Ydel As Double Dim XmaxData As Double, XminData As Double Dim YmaxData As Double, YminData As Double Dim Xpix As Double, Ypix As Double Dim Distort As Double, Distort_pc As Double Dim CycleCount As Long, MaxCycles As Long Dim AxisControlling As String Dim MoveDist As Double, Shift As Long Dim Margin As Double, Temp As Double ' Const SubName As String = "GiveActivePlotEqualScales" ' ' Determine whether the active chart is embedded in a worksheet or ' is a sheet in its own right. (If the activesheet's type is not ' a worksheet, assume that it is a chart.) ' IsEmbedded = (ActiveSheet.Type = xlWorksheet) ' With ActiveChart 'The "End With" for this is at the very end of the subroutine. ' ' Get various properties of the chart. Check chart type. ' PlotName = .Parent.Name TypeOfPlot = .Type SubtypeOfPlot = .ChartType If TypeOfPlot <> xlXYScatter Then MsgBox "Scale-equalising macro is intended only for an XY Scatter chart.", , _ PlotName & " / " & SubName Exit Sub End If ' ' Get presence/absence for each axis. ' HaveXaxis = .HasAxis(xlCategory) HaveYaxis = .HasAxis(xlValue) ' ' Determine the extreme X and Y values of all the data points, ' looping through all the data series on the chart. ' ' Note that VBA generates an error if we try to do anything with ' an empty series: hence the need for the "on error" statements. ' Xmin = 9.999999E+100: Ymin = Xmin: Xmax = -Xmin: Ymax = Xmax PointCount = 0 If IsEmbedded Then PlotNumb = ActiveChart.Parent.Index For Each s In ActiveSheet.ChartObjects(PlotNumb).Chart.SeriesCollection On Error Resume Next PointCount = PointCount + s.Points.Count PointsList = s.XValues Xmax = Application.Max(Xmax, PointsList) Xmin = Application.Min(Xmin, PointsList) PointsList = s.Values Ymax = Application.Max(Ymax, PointsList) Ymin = Application.Min(Ymin, PointsList) On Error GoTo 0 Next s Else For Each s In .SeriesCollection On Error Resume Next PointCount = PointCount + s.Points.Count PointsList = s.XValues Xmax = Application.Max(Xmax, PointsList) Xmin = Application.Min(Xmin, PointsList) PointsList = s.Values Ymax = Application.Max(Ymax, PointsList) Ymin = Application.Min(Ymin, PointsList) On Error GoTo 0 Next s End If ' ' Suppress the following two error messages, because in the present ' context the subroutine is being initiated automatically. (And ' we don't want to alarm the user, do we?) ' If PointCount <= 0 Then ' MsgBox "Chart contains no points.", , PlotName & " / " & SubName Exit Sub End If If Xmax - Xmin + Ymax - Ymin <= 1E-20 Then ' MsgBox "Chart is of zero size.", , PlotName & " / " & SubName Exit Sub End If ' ' Expand these maximum and minimum values very slightly, so that ' line segments running along the very edge of the graph area ' do not get missed. If the chart sub-type is "smoothed" ' use a bit more expansion, to allow for the smoothed edges to ' extend beyond the actual data points. ' ' The sizes used for these "margins" are no better than guesses. ' Margin = 0.005 If SubtypeOfPlot = xlXYScatterSmooth Or _ SubtypeOfPlot = xlXYScatterSmoothNoMarkers Then Margin = 0.04 Temp = Margin * (Xmax - Xmin) Xmax = Xmax + Temp Xmin = Xmin - Temp Temp = Margin * (Ymax - Ymin) Ymax = Ymax + Temp Ymin = Ymin - Temp ' ' Record these max & min values for later use. ' XminData = Xmin: XmaxData = Xmax: YminData = Ymin: YmaxData = Ymax ' ' If we have an X axis, find out what MajorUnit would auto-apply. ' If HaveXaxis Then With .Axes(xlCategory) .MaximumScaleIsAuto = True .MinimumScaleIsAuto = True .MajorUnitIsAuto = True Xdel = .MajorUnit .MaximumScaleIsAuto = False .MinimumScaleIsAuto = False .MajorUnitIsAuto = False End With If Xmax = Xmin Then Xdel = 0 End If ' ' If we have a Y axis, find out what MajorUnit would auto-apply. ' If HaveYaxis Then With .Axes(xlValue) .MaximumScaleIsAuto = True .MinimumScaleIsAuto = True .MajorUnitIsAuto = True Ydel = .MajorUnit .MaximumScaleIsAuto = False .MinimumScaleIsAuto = False .MajorUnitIsAuto = False End With If Ymax = Ymin Then Ydel = 0 End If ' ' If have both X and Y axes, use the larger MajorUnit for both. ' If HaveXaxis And HaveYaxis Then If Ydel >= Xdel Then Xdel = Ydel Else Ydel = Xdel End If End If ' ' For directions with axes, round the minimum values down to be ' multiples of the axis's MajorUnit. Round only the "minimum" ' values, since these are the ones that serve as the base for the ' markings along the axes. (And if we do it for the maximum ' as well we risk overconstraining our problem.) ' ' At the same time, set the MajorUnit. ' Note that the calculation for the MajorUnit needs to be ' set to "Auto" if the axis concerned is the only axis in use, ' or the unit spacing can be badly wrong. (MajorAxisIsAuto was ' set to False near the start of the subroutine.) ' If HaveXaxis And Xdel <> 0 Then Xmin = Xdel * Round((Xmin - 0.5 * Xdel) / Xdel) If HaveYaxis Then .Axes(xlCategory).MajorUnit = Xdel Else .Axes(xlCategory).MajorUnitIsAuto = True End If End If If HaveYaxis And Ydel <> 0 Then Ymin = Ydel * Round((Ymin - 0.5 * Ydel) / Ydel) If HaveXaxis Then .Axes(xlValue).MajorUnit = Ydel Else .Axes(xlValue).MajorUnitIsAuto = True End If End If ' ' Get the dimensions of the part of the chart used for the actual ' graphing, then use these to calculate the present values of the ' relative scaling factors in the X & Y directions. ' PlotInWd = .PlotArea.InsideWidth PlotInHt = .PlotArea.InsideHeight Xpix = (Xmax - Xmin) / PlotInWd Ypix = (Ymax - Ymin) / PlotInHt ' ' We can now set about equalising the scales. In an ideal world ' this would be a simple, single pass, exercise. But it turns ' out that, for a chart that has any axes displayed, a change to ' the defined extents of a displayed axis will sometimes change ' the chart's InsideWidth or InsideHeight properties. I cannot ' find a way to predict when this will or will not happen. ' ' This behaviour is a major PItA. It requires us to adopt an ' iterative approach. Implement the iterations with a For—Next ' loop, and set a fairly low limit on the maximum number of ' iterations allowed. (But not too low: I had one chart which ' required 9 iterations to achieve adequately equal scales.) ' MaxCycles = 15 For CycleCount = 1 To MaxCycles ' ' Adjust one of the scales in an attempt to achieve equality. ' If Ypix < Xpix Then ' ' X DIRECTION CONTROLS THE SIZE OF THE CHART. ' AxisControlling = "X" ' 'Set the X-axis extents to the data's extents. ' .HasAxis(xlCategory) = True .Axes(xlCategory).MinimumScale = Xmin .Axes(xlCategory).MaximumScale = Xmax If Not HaveXaxis Then .HasAxis(xlCategory) = False ' ' Recalculate the scaling factors, which might have changed. ' PlotInWd = .PlotArea.InsideWidth PlotInHt = .PlotArea.InsideHeight Xpix = (Xmax - Xmin) / PlotInWd Ypix = (Ymax - Ymin) / PlotInHt ' ' Calculate the value of Ymax that will result in ' the same value for the scale of the Y-axis as we ' have just defined for the scale of the X-axis. ' Ymax = Ymin + Xpix * PlotInHt ' ' The available space in the Y-direction will be greater ' than what is needed by the actual graphing. Attempt ' to position the graphing centrally in this space. If ' the chart has its Y-axis displayed, then any shift ' must be a multiple of the MajorUnit. ' MoveDist = 0.5 * (Ymax + Ymin - YmaxData - YminData) If HaveYaxis Then Shift = Round(MoveDist / Ydel, 0) Ymin = Ymin - Shift * Ydel Ymax = Ymax - Shift * Ydel Else Ymin = Ymin - MoveDist Ymax = Ymax - MoveDist End If ' ' Set the Y-axis extents to these calculated values. ' .HasAxis(xlValue) = True .Axes(xlValue).MinimumScale = Ymin .Axes(xlValue).MaximumScale = Ymax If Not HaveYaxis Then .HasAxis(xlValue) = False Else ' ' Y DIRECTION CONTROLS THE SIZE OF THE CHART. ' AxisControlling = "Y" ' ' Set the Y-axis extents to the data's extents. ' .HasAxis(xlValue) = True .Axes(xlValue).MinimumScale = Ymin .Axes(xlValue).MaximumScale = Ymax If Not HaveYaxis Then .HasAxis(xlValue) = False ' ' Recalculate the scaling factors, which might have changed. ' PlotInWd = .PlotArea.InsideWidth PlotInHt = .PlotArea.InsideHeight Xpix = (Xmax - Xmin) / PlotInWd Ypix = (Ymax - Ymin) / PlotInHt ' ' Calculate the value of Xmax that will result in ' the same value for the scale of the X-axis as we ' have just defined for the scale of the Y-axis. ' Xmax = Xmin + Ypix * PlotInWd ' ' The available space in the X-direction will be greater ' than what is needed by the actual graphing. Attempt ' to position the graphing centrally in this space. If ' the chart has its X-axis displayed, then any shift ' must be a multiple of the MajorUnit. ' MoveDist = 0.5 * (Xmax + Xmin - XmaxData - XminData) If HaveXaxis Then Shift = Round(MoveDist / Xdel, 0) Xmin = Xmin - Shift * Xdel Xmax = Xmax - Shift * Xdel Else Xmin = Xmin - MoveDist Xmax = Xmax - MoveDist End If ' ' Set the X-axis extents to these calculated values. ' .HasAxis(xlCategory) = True .Axes(xlCategory).MinimumScale = Xmin .Axes(xlCategory).MaximumScale = Xmax If Not HaveXaxis Then .HasAxis(xlCategory) = False End If ' ' Recalculate the scaling factors, which might have changed yet again. ' PlotInWd = .PlotArea.InsideWidth PlotInHt = .PlotArea.InsideHeight Xpix = (Xmax - Xmin) / PlotInWd Ypix = (Ymax - Ymin) / PlotInHt ' ' If the discrepancy between the scaling factors is less than ' say 0.5%, then we can apply the Bobby McFerrin / Meher Baba ' algorithm ("Don't worry, be happy"). ' ' Otherwise, sigh deeply and begin another iteration. ' Distort = Abs((Xpix - Ypix) / (Xpix + Ypix)) If Distort < 0.0025 Then GoTo Finish_Off Next CycleCount ' ' Tell the long-suffering user that adequate convergence ' has not been achieved. Then carry on regardless. ' Distort_pc = Round(100 * Distort, 1) MsgBox "Discrepancy between scales is " & Distort_pc & "%" & Chr(13) & _ "after " & MaxCycles & " iterations.", , _ PlotName & " / " & SubName ' Finish_Off: ' End With 'Terminates the "With ActiveChart" near the top of the subroutine. ' End Sub
RE: Subroutine to force XY-chart to have equal scales
You also ought to put this in a FAQ in this forum.
BTW a somewhat similar approch can be constructed to equalize a Primary and Secondary axis, calling it in the Change event for the chart's source data table.
Skip,
Just traded in my OLD subtlety...
for a NUance!
RE: Subroutine to force XY-chart to have equal scales
(You seem to be spending more time on Eng-Tips these days, in addition to your prodigious presence on Tek-Tips: we are all the better for it.)
RE: Subroutine to force XY-chart to have equal scales
When X or Y change the chart rescales automatically, without macro.
Hope it helps!
Yakpol.
RE: Subroutine to force XY-chart to have equal scales
For your demo chart displaying on my screen it's a case of "close but no cigar". Your chart displays with significantly unequal scales: the vertical scale is compressed by approximately 12% compared to the horizontal scale. This "error" increases to about 18% if I delete the display of the horizontal axis. The display or non-display of the vertical axis makes no difference.
Part of this "error" seems to come from the fact that when I open your demo spreadsheet the yellowed "plot area" is not exactly square, but is slightly landscaped. I assume this was not the case on your screen before you uploaded the spreadsheet.
This all suggests to me that your method can only be relied upon to give approximately equal scales. Firstly it seems sensitive to the screen type being used to display the chart, which would be a problem for a spreadsheet that was going to have broad usage. Secondly its accuracy is sensitive to the presence/absence of one of the axes. It also has the limitation that it requires the plot area to be square (although I imagine that one could relatively easily generalise it to accommodate any pre-known rectangularity ratio for the plot area).
RE: Subroutine to force XY-chart to have equal scales
RE: Subroutine to force XY-chart to have equal scales
RE: Subroutine to force XY-chart to have equal scales
RE: Subroutine to force XY-chart to have equal scales
[I'm sure I don't have to remind you that this whole damned thing was your fault in the first place