Proportional Chart

[Guest]

I am using a chart to visibly create an object. I would like to force the
scaling of the chart (xy scatter) to always be equivalent units (of length in
my case) in both axis directions. I like the chart to auto-scale for size
but if the chart scales different for each direction then my objects are
skewed.

If anyone has code ideas or suggestions I would greatly appreciate any help
I can get.

Thanks,

Cody

 

[Guest]

You could write some code to compare the maximum value of X and Y, and then
scale both axis considering the highest value.

Best,

Rafael

 

[Tushar Mehta]

I don't understand what appears to be a contradictory requirement of
"like the chart to auto-scale" and "force the scaling"

In any case, use the macro recorder to get the code for what you want.
Use Tools | Macro > Record new macro... do whatever it is you want and
turn off the recorder. XL will give you the necessary code that you
can then customize / generalize.

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Guest]

My request is that the chart autoscale to my data but scale is such a manner
that x and y increments are equivalent. I am plotting objects so a unit
length in x must visually equal a unit length in y.

Hope that is clearer.

 

[Guest]

Hi Cody,

You didn't provide enough information, playing with charts can be tricky...

But, assuming:

1) Your scatter is the only chartobject in a worksheet
2) You are plotting only positive values
3) your data is in the same worksheet

the code below, copied to the worksheet code page, will update the scales of
the chart whenever values change:

Private Sub Worksheet_Change(ByVal Target As Range)

With ActiveSheet.ChartObjects(1).Chart
'Autoscale axes first
.Axes(1).MaximumScaleIsAuto = True
.Axes(2).MaximumScaleIsAuto = True
.Refresh

'Make both equal to highest
If .Axes(1).MaximumScale > .Axes(2).MaximumScale Then
.Axes(2).MaximumScale = .Axes(1).MaximumScale
Else
.Axes(1).MaximumScale = .Axes(2).MaximumScale
End If
End With
End Sub

Best,

Rafael

 

[Tushar Mehta]

Select a chart and run the fixScale subroutine below. See it for
documentation and limitations and comments on applicability and
effectiveness.

Option Explicit

Function VisualRatioDiff(aPlotArea As PlotArea, _
XUnits As Double, YUnits As Double) As Double
'for some bizarre reason, on occassion, the most obvious and _
direct approach of _
VisualRatioDiff = _
aPlotArea.Width / XUnits - aPlotArea.Height / YUnits _
results in an overflow error. Don't ask _
why! Hence the roundabout way of getting the result.
Dim AreaWidth As Double, AreaHeight As Double
AreaWidth = aPlotArea.Width
AreaHeight = aPlotArea.Height
VisualRatioDiff = AreaWidth / XUnits - AreaHeight / YUnits
End Function

Function NbrMajorUnits(anAxis As Axis) As Double
'for some bizarre reason, on occassion, the most obvious and _
direct approach of _
NbrMajorUnits = _
(.MaximumScale - .MinimumScale) / .MajorUnit _
results in NbrMajorUnits becoming -1.#IND or 1.#QNAN. Don't _
ask why! Hence the roundabout way of getting the result.
Dim MaxScale As Double, MinScale As Double, MajUnit As Double
With anAxis
MaxScale = .MaximumScale
MinScale = .MinimumScale
MajUnit = .MajorUnit
End With
NbrMajorUnits = (MaxScale - MinScale) / MajUnit
End Function

Sub fixScale()
'The procedure attempts to set the same physical distance per _
major unit for both the x- and y-axes. What this means is _
that the major unit marks (or major unit gridlines) will _
appear as squares. _
_
The code contains no protection as to the chart type. It also _
does not attempt to get smart about what is happening nor does _
it change any axes settings. Obviously, this code is only _
meaningful for a XY Scatter chart or a Line/Column/Area chart _
where the x-axis has a 'time scale'. _
_
In limited testing the code consistently succeeded when all axes _
attributes are set to automatic. _
_
With one or more attributes set by the user, the performance _
depends on the size of the chart (or chartobject) and how XL _
responds to changes in the plotarea dimension. The bottom _
line is that the code finds a successful solution sometimes _
but not always.
Dim XUnits As Double, YUnits As Double, _
I As Byte
With ActiveChart
.PlotArea.Height = .ChartArea.Height
.PlotArea.Width = .ChartArea.Width
For I = 1 To 10 'when the plotarea width changes, XL may _
change the max/min scale values and/or font sizes. _
This loop lets us reach an equilibrium
XUnits = NbrMajorUnits(.Axes(xlCategory, xlPrimary))
YUnits = NbrMajorUnits(.Axes(xlValue, xlPrimary))
If Abs(VisualRatioDiff(.PlotArea, XUnits, YUnits)) _
<= 0.000001 Then
ElseIf VisualRatioDiff(.PlotArea, XUnits, YUnits) > 0 Then
Do
.PlotArea.Width = .PlotArea.Width - 1
XUnits = NbrMajorUnits(.Axes(xlCategory, xlPrimary))
YUnits = NbrMajorUnits(.Axes(xlValue, xlPrimary))
Loop While _
VisualRatioDiff(.PlotArea, XUnits, YUnits) > 0
Else
Do
.PlotArea.Height = .PlotArea.Height - 1
XUnits = NbrMajorUnits(.Axes(xlCategory, xlPrimary))
YUnits = NbrMajorUnits(.Axes(xlValue, xlPrimary))
Loop Until _
VisualRatioDiff(.PlotArea, XUnits, YUnits) > 0
End If
Next I
If Abs(VisualRatioDiff(.PlotArea, XUnits, YUnits)) <= 0.000001 Then
MsgBox "The major units should be square in shape." _
& vbNewLine _
& "The difference in the ratio is " & _
VisualRatioDiff(.PlotArea, XUnits, YUnits)
Else
MsgBox "After " & I - 1 & " attempts the visual ratio " _
& "difference (" _
& VisualRatioDiff(.PlotArea, XUnits, YUnits) _
& ") does not approach zero"
End If
End With
End Sub
Sub checkResults()
Dim xMin As Double, xMax As Double, _
YMin As Double, YMax As Double, _
XMajorUnit As Double, YMajorUnit As Double, _
XUnits As Double, YUnits As Double

With ActiveChart
XUnits = NbrMajorUnits(.Axes(xlCategory, xlPrimary))
YUnits = NbrMajorUnits(.Axes(xlValue, xlPrimary))
Debug.Print .PlotArea.Width / XUnits; .PlotArea.Height / YUnits; _
VisualRatioDiff(.PlotArea, XUnits, YUnits)
End With
End Sub

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions