I think I have come up with a solution. See below.
[tt]
----------
Sub MakePlotGridSquare()
'
' Changes the scale of an Excel graph along one of its two axes by exactly
' the right amount to result in equal X and Y scales.
' Note that the chart has to be "active" when the macro is run.
'
' Grabbed from Eng-Tips' "Spreadsheets" forum, where it was placed
' by Panars on 2 Dec 2005. Electricpete then made an improvement in that forum.
'
' Subsequent modifications made to accommodate plots without axes.
'
' Original source appears to have been
'
'
' Macro seems to have intermittent difficulties if an axis title
' overlaps with the actual axis, in that it sometimes moves things around
' and sometimes doesn't.
' However no engineer would allow such a graph on a spreadsheet.
'
Dim plotInHt As Integer, plotInWd As Integer
Dim HaveXaxis As Boolean, HaveYaxis As Boolean
Dim Ymax As Double, Ymin As Double, Ydel As Double
Dim Xmax As Double, Xmin As Double, Xdel As Double
Dim Ypix As Double, Xpix As Double, GridSz As Double
'
With ActiveChart
'
' Get plot size.
'
With .PlotArea
plotInHt = .InsideHeight
plotInWd = .InsideWidth
End With
'
' Get presence/absence for each axis.
'
HaveXaxis = .HasAxis(xlCategory)
HaveYaxis = .HasAxis(xlValue)
'
' Deal first with the X axis.
' (1) Turn it on if it is not already on;
' (2) Set its scaling stuff to "auto";
' (3) Record its extreme values and then lock the scale.
'
If Not HaveXaxis Then .HasAxis(xlCategory) = True
With .Axes(xlCategory)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
.MajorUnitIsAuto = True
End With
With .Axes(xlCategory)
Xmax = .MaximumScale
Xmin = .MinimumScale
Xdel = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
'
' Repeat the process for the Y axis.
'
If Not HaveYaxis Then .HasAxis(xlValue) = True
With .Axes(xlValue)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
.MajorUnitIsAuto = True
End With
With .Axes(xlValue)
Ymax = .MaximumScale
Ymin = .MinimumScale
Ydel = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
'
' Determine grid size to utilize.
'
If Ydel >= Xdel Then
GridSz = Ydel
Else
GridSz = Xdel
End If
'
.Axes(xlValue).MajorUnit = GridSz
.Axes(xlCategory).MajorUnit = GridSz
'
' Pixels per grid ...
'
Ypix = plotInHt * GridSz / (Ymax - Ymin)
Xpix = plotInWd * GridSz / (Xmax - Xmin)
'
' Keep plot size as is, but adjust the appropriate scale.
'
If Xpix > Ypix Then
.Axes(xlCategory).MaximumScale = plotInWd * GridSz / Ypix + Xmin
Else
.Axes(xlValue).MaximumScale = plotInHt * GridSz / Xpix + Ymin
End If
'
' Return presence/absence of axes back to the way it was.
'
If Not HaveXaxis Then .HasAxis(xlCategory) = False
If Not HaveYaxis Then .HasAxis(xlValue) = False
End With
'
End Sub
----------
[/tt]
Please attack it with gusto: I want it to end up as bullet-proof as possible.
PS. How do I have my code appear in a snappy little subwindow like Panars used above?
