Sub ListChartNames()
Dim j As Integer
Dim NumSheets As Integer
Dim MyListSht
MyListSht = ActiveSheet.Name
NumSheets = Sheets.Count
For j = 1 To NumSheets
Sheets(j).Activate
For Each ChObj In ActiveSheet.ChartObjects
lr = Sheets(MyListSht).Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets(MyListSht).Cells(lr, 1) = Sheets(j).Name
Sheets(MyListSht).Cells(lr, 2) = ChObj.Name
Next ChObj
Next j
End Sub
Sub FixYAxisLimits()
Dim dMin As Double
Dim dMax As Double
Dim dSpan As Double
Dim dLog As Double
Dim dPre As Double
Dim dMaj As Double
Dim dUnit As Double
Dim cht As Chart
Dim iSrs As Long
dMin = 1E+307
dMax = -1E+307
Set cht = ActiveSheet.ChartObjects(Application.Caller).Chart
For iSrs = 1 To cht.SeriesCollection.Count
With cht.SeriesCollection(iSrs)
If dMin > WorksheetFunction.Min(.Values) Then
dMin = WorksheetFunction.Min(.Values)
End If
If dMax < WorksheetFunction.Max(.Values) Then
dMax = WorksheetFunction.Max(.Values)
End If
End With
Next
If dMax = dMin Then dMax = dMin + 1
dSpan = dMax - dMin
If dMin <> 0 Then dMin = dMin - dSpan / 100
If dMax <> 0 Then dMax = dMax + dSpan / 100
dLog = Int(Log(dSpan) / 2.303)
dPre = dSpan / (10 ^ dLog)
Select Case True
Case dPre > 5
dUnit = 1
Case dPre > 2
dUnit = 0.5
Case dPre > 1
dUnit = 0.2
Case Else
dUnit = 0.1
End Select
dMaj = dUnit * (10 ^ dLog)
With cht.Axes(xlValue)
If .MaximumScale < .MinimumScale = Int(dMin / dMaj) Then
.MinimumScale = Int(dMin / dMaj) * dMaj
.MaximumScale = Int(dMax / dMaj + 1) * dMaj
Else
.MaximumScale = Int(dMax / dMaj + 1) * dMaj
.MinimumScale = Int(dMin / dMaj) * dMaj
End If
.MajorUnit = dMaj
End With
End Sub