Forcing an Excel chart to have equal X & Y scales
Forcing an Excel chart to have equal X & Y scales
(OP)
This post is a long-overdue update to a 2005 discussion on this forum. See thread770-141275: How do I plot a circle?. The discussions ended up focussing on how to achieve equal X and Y scales in Excel's XY-Scatter charts, and the final result was a passably-reliable VBA subroutine.
Over the years since then I have used that subroutine numerous times, and in so doing I have gradually made it more reliable and more robust. The latest version of this subroutine is presented below. I hope it will help any others who have wrestled with this problem.
Over the years since then I have used that subroutine numerous times, and in so doing I have gradually made it more reliable and more robust. The latest version of this subroutine is presented below. I hope it will help any others who have wrestled with this problem.
CODE
Sub GiveActivePlotEqualScales()
'
' 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 original subroutine was developed by Jon Peltier, and placed
' on his www.peltiertech.com/Excel/Charts/SquareGrid.html web page.
' A modified version of this 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 further
' modifications to it.
'
' 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. I believe that this updated
' incarnation of the subroutine has rectified this problem, as well
' as introducing a few more refinements.
'
' 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.
'
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, 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
For Each s In ActiveSheet.ChartObjects(PlotName).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
If PointCount <= 0 Then
MsgBox "Chart contains no data points.", , 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 a guess on my part.)
'
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 also do it for the maximum
' we risk overconstraining our problem.)
'
' Also, set the MajorUnit.
'
If HaveXaxis And Xdel <> 0 Then
Xmin = Xdel * Round((Xmin - 0.5 * Xdel) / Xdel)
.Axes(xlCategory).MajorUnit = Xdel
End If
If HaveYaxis And Ydel <> 0 Then
Ymin = Ydel * Round((Ymin - 0.5 * Ydel) / Ydel)
.Axes(xlValue).MajorUnit = Ydel
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 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 so 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 so 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
'
' 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 original subroutine was developed by Jon Peltier, and placed
' on his www.peltiertech.com/Excel/Charts/SquareGrid.html web page.
' A modified version of this 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 further
' modifications to it.
'
' 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. I believe that this updated
' incarnation of the subroutine has rectified this problem, as well
' as introducing a few more refinements.
'
' 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.
'
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, 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
For Each s In ActiveSheet.ChartObjects(PlotName).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
If PointCount <= 0 Then
MsgBox "Chart contains no data points.", , 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 a guess on my part.)
'
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 also do it for the maximum
' we risk overconstraining our problem.)
'
' Also, set the MajorUnit.
'
If HaveXaxis And Xdel <> 0 Then
Xmin = Xdel * Round((Xmin - 0.5 * Xdel) / Xdel)
.Axes(xlCategory).MajorUnit = Xdel
End If
If HaveYaxis And Ydel <> 0 Then
Ymin = Ydel * Round((Ymin - 0.5 * Ydel) / Ydel)
.Axes(xlValue).MajorUnit = Ydel
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 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 so 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 so 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: Forcing an Excel chart to have equal X & Y scales
Thanks for sharing your efforts... including generous commenting within the code which really helps the slower among us like me.
=====================================
Eng-tips forums: The best place on the web for engineering discussions.
RE: Forcing an Excel chart to have equal X & Y scales
The lines
CODE
MsgBox "Chart is of zero size.", , PlotName & " / " & SubName
Exit Sub
End If
CODE
MsgBox "Chart contains no points.", , PlotName & " / " & SubName
Exit Sub
End If
Electricpete. Thanks for your kind words. Also for your involvement in the original post. But you misunderstand the reason for the comments in my subroutine. They are there for my benefit, not yours: there is nothing more embarrassing than to return to one's own work after a few months and not understand it.
RE: Forcing an Excel chart to have equal X & Y scales
Tata
RE: Forcing an Excel chart to have equal X & Y scales
However I usually want it to run under VBA control. To achieve this I use the following subroutine, which attempts a guess as to which chart is to be operated upon, makes it active, then calls GiveActivePlotEqualScales. You might have to make some minor changes to it to get it to suit your circumstances, particularly if your spreadsheet is protected (like mine usually are).
I usually set my spreadsheets up so that MakePlotActive is called from the Worksheet_Change event handler.
The subroutine, like GiveActivePlotEqualScales itself, started life as a Jon Peltier production.
CODE
'
' Runs GiveActivePlotEqualScales().
'
' First tries to run it on the active chart on the active sheet.
' If no chart is active and there is exactly one chart on the active sheet
' it will work on that chart. If there is more than one chart on the
' sheet it gives up.
'
' The macro also works if the active chart is a chartsheet rather than a chart
' that is embedded in a worksheet.
'
Dim OldRow As Long, OldCol As Long, ShtProtected As Boolean
Dim OldCell, OldUpdateState, Targ As String, ChartCount As Long
'
If ActiveChart Is Nothing Then
'
' Since there is no active chart, we can only know which chart to work on
' if there is precisely one chart on the active sheet.
'
ChartCount = ActiveSheet.ChartObjects.Count
If ChartCount < 1 Then
MsgBox "Active sheet does not contain any charts."
Exit Sub
End If
If ChartCount > 1 Then
MsgBox "Please select the chart whose scales you want to equalise."
Exit Sub
End If
'
' Some preliminaries, for speed and so the screen can be restored correctly.
'
OldUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False
OldRow = ActiveWindow.ScrollRow
OldCol = ActiveWindow.ScrollColumn
Set OldCell = ActiveCell
'
' If sheet is protected it must be unprotected,
' but note hard-wired password.
'
ShtProtected = ActiveSheet.ProtectContents
If ShtProtected Then ActiveSheet.Unprotect Password:="P U T Y O U R P / W H E R E"
'
ActiveSheet.ChartObjects(1).Activate
Call GiveActivePlotEqualScales
'
If ShtProtected Then _
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:="P U T Y O U R P / W H E R E"
'
' Clean up with the "postliminaries".
'
OldCell.Activate
ActiveWindow.ScrollRow = OldRow
ActiveWindow.ScrollColumn = OldCol
Application.ScreenUpdating = OldUpdateState
Else
Call GiveActivePlotEqualScales
End If
'
End Sub
CODE
ActiveSheet.ChartObjects(1).Activate
Call GiveActivePlotEqualScales
End Sub