alancardoso
Board Regular
- Joined
- Nov 9, 2004
- Messages
- 85
Hi Guys.
Could you help me? I´m trying to write a code that makes Excel automatically scale a chart with two series of data (primary and secondary axis).
I have found a code (not mine) that does that - but it works only for charts that have the primary axis with data.
The code is below.
Any help would be greatly appreciated.
Thanks!
Sub ScaleCharts()
'
' ScaleCharts Macro
'
Dim objCht As ChartObject
Dim maxi As Double, mini As Double, Range, Adj As Double, xMax As Double, xMin As Double
Dim Round As Integer, Order As Integer, x As Integer, i As Integer
Application.ScreenUpdating = False
For x = 1 To ActiveWorkbook.Sheets.Count
Application.StatusBar = "Crunching sheet " & x & " of " & ActiveWorkbook.Sheets.Count
For Each objCht In Sheets(x).ChartObjects
If objCht.Chart.ChartType = xlLine Or objCht.Chart.ChartType = xlXYScatter Then
With objCht.Chart
For i = 0 To .SeriesCollection.Count - 1 'Loop through all the series in the chart
'Get the Max and Min values of the data in the chart
maxi = Application.Max(.SeriesCollection(i + 1).Values)
mini = Application.Min(.SeriesCollection(i + 1).Values)
Range = maxi - mini
If Range > 1 Then
Order = Len(Int(Range))
Adj = 10 ^ (Order - 2)
Round = -1 * (Order - 1)
ElseIf Range <> 0 Then
Order = Len(Int(1 / Range))
Adj = 10 ^ (-1 * Order)
Round = Order - 1
End If
'Get the Max and Min values for the axis based on the data
If i = 0 Or WorksheetFunction.Round(maxi, Round + 1) + Adj > xMax Then
xMax = WorksheetFunction.Round(maxi, Round + 1) + Adj
End If
If i = 0 Or WorksheetFunction.Round(mini, Round + 1) - Adj < xMin Then
xMin = WorksheetFunction.Round(mini, Round + 1) - Adj - 0.2
End If
Next i
With .Axes(xlValue)
.MaximumScale = xMax
.MinimumScale = xMin
End With
End With
End If
Next objCht
Next x
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Could you help me? I´m trying to write a code that makes Excel automatically scale a chart with two series of data (primary and secondary axis).
I have found a code (not mine) that does that - but it works only for charts that have the primary axis with data.
The code is below.
Any help would be greatly appreciated.
Thanks!
Sub ScaleCharts()
'
' ScaleCharts Macro
'
Dim objCht As ChartObject
Dim maxi As Double, mini As Double, Range, Adj As Double, xMax As Double, xMin As Double
Dim Round As Integer, Order As Integer, x As Integer, i As Integer
Application.ScreenUpdating = False
For x = 1 To ActiveWorkbook.Sheets.Count
Application.StatusBar = "Crunching sheet " & x & " of " & ActiveWorkbook.Sheets.Count
For Each objCht In Sheets(x).ChartObjects
If objCht.Chart.ChartType = xlLine Or objCht.Chart.ChartType = xlXYScatter Then
With objCht.Chart
For i = 0 To .SeriesCollection.Count - 1 'Loop through all the series in the chart
'Get the Max and Min values of the data in the chart
maxi = Application.Max(.SeriesCollection(i + 1).Values)
mini = Application.Min(.SeriesCollection(i + 1).Values)
Range = maxi - mini
If Range > 1 Then
Order = Len(Int(Range))
Adj = 10 ^ (Order - 2)
Round = -1 * (Order - 1)
ElseIf Range <> 0 Then
Order = Len(Int(1 / Range))
Adj = 10 ^ (-1 * Order)
Round = Order - 1
End If
'Get the Max and Min values for the axis based on the data
If i = 0 Or WorksheetFunction.Round(maxi, Round + 1) + Adj > xMax Then
xMax = WorksheetFunction.Round(maxi, Round + 1) + Adj
End If
If i = 0 Or WorksheetFunction.Round(mini, Round + 1) - Adj < xMin Then
xMin = WorksheetFunction.Round(mini, Round + 1) - Adj - 0.2
End If
Next i
With .Axes(xlValue)
.MaximumScale = xMax
.MinimumScale = xMin
End With
End With
End If
Next objCht
Next x
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub