问从海图轴中提取最大值

EN

Public Function getAxisMaxScale(cht As Chart) As Single

Dim ax As Axis
Set ax = cht.Axes(xlValue)

getAxisMaxScale= ax.MaximumScale


End Function

Public sub adjustAxisForChartXYZ()

Dim cht As Chart
Set cht = ThisWorkbook.Sheets("XYZ")   'insert sheetname of your chart

adjustSecondaryAxis cht

End Sub


Public Sub adjustSecondaryAxis(cht As Chart)

Dim axPrimary As Axis, axSecondary As Axis
Set axPrimary = cht.Axes(xlValue)

Set axSecondary = cht.Axes(xlValue, xlSecondary)

With axSecondary
    .MajorUnit = axPrimary.MajorUnit
    .MaximumScale = axPrimary.MaximumScale
End With

End Sub

Sub Macro4()
'
' Macro4 Macro
'

'
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MaximumScale = 60
    ActiveChart.Axes(xlValue, xlSecondary).Select
    ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = 90
    Range("L2").Select
End Sub  

Sub Test()
    
    Sheet1.ChartObjects("Chart 2").Chart.Axes(xlValue, xlSecondary).MaximumScale = _
        Sheet1.ChartObjects("Chart 2").Chart.Axes(xlValue).MaximumScale

End Sub

Dim ser as SeriesCollection
' `ChartArea.Parent` = `Chart` object
Set ser = Selection.Parent.SeriesCollection()

Dim temp1() As Variant, temp2() As Variant
temp1 = ser(1).values
temp2 = ser(2).values
    
' Get the data limits
Dim a_1 As Double, a_2 As Double, b_1 As Double, b_2 As Double
a_1 = WorksheetFunction.Min(temp1): a_2 = WorksheetFunction.Min(temp2)
b_1 = WorksheetFunction.Max(temp1): b_2 = WorksheetFunction.Max(temp2)

Public Sub DualYAxisChart(ByRef ch As Chart)
    Dim x_axis_1 As Axis, x_axis_2 As Axis, n As Long
    Dim ser As SeriesCollection
    Set ser = ch.SeriesCollection()
    If ser.Count <> 2 Then
        MsgBox "Please select a chart with two series", vbOKOnly, "Dual y-axis Chart"
        Exit Sub
    End If
    
    If UBound(ser(1).values) <> UBound(ser(2).values) Then
        MsgBox "Both series must share the same number of points", vbOKOnly, "Dual y-axis Chart"
        Exit Sub
    End If
    n = UBound(ser(1).values)
    
    ser(1).AxisGroup = xlPrimary
    ser(2).AxisGroup = xlSecondary
    
    ' Enable Both Y-axes
    ch.SetElement msoElementPrimaryValueAxisShow
    ch.SetElement msoElementSecondaryValueAxisShow
    ' Enable Both X-axes
    ch.SetElement msoElementPrimaryCategoryAxisShow
    ch.SetElement msoElementSecondaryCategoryAxisShow
       
    ' Delete Secondary x-axis
    ch.SetElement msoElementSecondaryCategoryAxisNone
    
    Set x_axis_1 = ch.Axes(xlValue, xlPrimary)
    Set x_axis_2 = ch.Axes(xlValue, xlSecondary)
    
    x_axis_1.format.Line.ForeColor.RGB = ser(1).format.Line.ForeColor.RGB
    x_axis_1.format.Line.EndArrowheadStyle = msoArrowheadTriangle
    x_axis_2.format.Line.ForeColor.RGB = ser(2).format.Line.ForeColor.RGB
    x_axis_2.format.Line.EndArrowheadStyle = msoArrowheadTriangle

    
    ' Auto Scale All
    x_axis_1.MajorUnitIsAuto = True
    x_axis_1.MaximumScaleIsAuto = True
    x_axis_1.MinimumScaleIsAuto = True
    x_axis_2.MajorUnitIsAuto = True
    x_axis_2.MaximumScaleIsAuto = True
    x_axis_2.MinimumScaleIsAuto = True
    
    Dim a_1 As Double, a_2 As Double, b_1 As Double, b_2 As Double
    Dim x_1 As Double, s_1 As Double, x_2 As Double, s_2 As Double, g_1 As Double, g_2 As Double
    Dim n_1 As Long, n_2 As Long, sense As Long
    
    ' Get the axis limits
    s_1 = x_axis_1.MinimumScale
    x_1 = x_axis_1.MaximumScale
    g_1 = x_axis_1.MajorUnit
    n_1 = CLng((x_1 - s_1) / g_1)
    
    s_2 = x_axis_2.MinimumScale
    x_2 = x_axis_2.MaximumScale
    g_2 = x_axis_2.MajorUnit
    n_2 = CLng((x_2 - s_2) / g_2)
    
    Dim temp1() As Variant, temp2() As Variant
    temp1 = ser(1).values
    temp2 = ser(2).values
        
    ' Get the data limits
    a_1 = WorksheetFunction.Min(temp1): a_2 = WorksheetFunction.Min(temp2)
    b_1 = WorksheetFunction.Max(temp1): b_2 = WorksheetFunction.Max(temp2)
    
    sense = Sgn((b_2 - a_2) / (b_1 - a_1))
    
    If sense < 0 Then
        x_axis_2.ReversePlotOrder = True
        Swap a_2, b_2
        x_axis_2.format.Line.EndArrowheadStyle = msoArrowheadNone
        x_axis_2.format.Line.BeginArrowheadStyle = msoArrowheadTriangle
    End If
    
    x_axis_1.MinimumScale = a_1: x_axis_1.MaximumScale = b_1
    g_1 = x_axis_1.MajorUnit
    n_1 = CLng((x_1 - s_1) / g_1)
    x_axis_2.MinimumScale = a_2: x_axis_2.MaximumScale = b_2
    g_2 = x_axis_2.MajorUnit
    n_2 = CLng((x_2 - s_2) / g_2)
    
    g_2 = (x_2 - s_2) / n_1
    x_axis_2.MajorUnit = g_2
        
    Dim i_1 As Long, i_2 As Long
    i_1 = WorksheetFunction.Floor_Math(a_1 / g_1)
    s_1 = i_1 * g_1
    i_2 = WorksheetFunction.Floor_Math(a_2 / g_2)
    s_2 = i_2 * g_2
    
    Dim j_1 As Long, j_2 As Long
    j_1 = WorksheetFunction.Ceiling_Math(b_1 / g_1)
    x_1 = j_1 * g_1
    j_2 = WorksheetFunction.Ceiling_Math(b_2 / g_2)
    x_2 = j_2 * g_2
    
    x_axis_1.MinimumScale = s_1: x_axis_1.MaximumScale = x_1
    x_axis_2.MinimumScale = s_2: x_axis_2.MaximumScale = x_2
    
    x_axis_1.MajorUnitIsAuto = True
    g_1 = x_axis_1.MajorUnit
    n_1 = CLng((x_1 - s_1) / g_1)
        
    
    g_2 = (x_2 - s_2) / n_1
    x_axis_2.MajorUnit = g_2

End Sub