朝着VBA系列Y軸對稱的Excel

Question

我已經使用圖表對象和SeriesCollection.NewSeries 代碼的部分是這樣的

Private Function AddSeriesAndFormats(PPSChart As Chart, shInfo As Worksheet, tests() As PPS_Test, RowCount As Integer, col As Integer, smoothLine As Boolean, lineStyle As String, transparency As Integer, lineWidth As Single, ByRef position As Integer) As Series 

Dim mySeries As Series 

Set mySeries = PPSChart.SeriesCollection.NewSeries 
With mySeries 
    .Name = tests(0).GetString() 
    .XValues = "='" & shInfo.Name & "'!R" & RowCount - UBound(tests) - 1 & "C" & CInt(4 * (col + 1) - 2) & ":R" & RowCount - 1 & "C" & CInt(4 * (col + 1) - 2) 
    .Values = "='" & shInfo.Name & "'!R" & RowCount - UBound(tests) - 1 & "C" & CInt(4 * (col + 1) - 1) & ":R" & RowCount - 1 & "C" & CInt(4 * (col + 1) - 1) 
    .Smooth = smoothLine 
    .Format.line.Weight = lineWidth 
    .Format.line.DashStyle = GetLineStyle(lineStyle) 
    .Format.line.transparency = CSng(transparency/100) 
    .MarkerStyle = SetMarkerStyle(position) 
    .MarkerSize = 9 
    .MarkerForegroundColorIndex = xlColorIndexNone 
End With 

Set AddSeriesAndFormats = mySeries 

End Function 

和PPSChart被這樣

創建情節做了一些重複

Private Function AddChartAndFormatting(chartName As String, chartTitle As String, integralBuffer As Integer, algoPropertyName As String) As Chart 

Dim PPSChart As Chart, mySeries As Series 

Set PPSChart = Charts.Add 
With PPSChart 
    .Name = chartName 
    .HasTitle = True 
    .chartTitle.Characters.Text = chartTitle 
    .ChartType = xlXYScatterLines 
    .Axes(xlCategory, xlPrimary).HasTitle = True 
    .Axes(xlValue, xlPrimary).HasTitle = True 
    If algoPropertyName <> "" Then 'case for Generic PPS plots 
     .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = algoPropertyName 
    Else 
     .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "PL/PR max(avg_" & integralBuffer & "ms) [mbar]" 'case for the bumper obsolate algorithm 
    End If 
    .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Bumper Position [mm]" 
End With 

' delete random series that might be generated 
For Each mySeries In PPSChart.SeriesCollection 
    mySeries.Delete 
Next mySeries 

Set AddChartAndFormatting = PPSChart 

End Function 

結果的一個例子是像在下面 我想是有從-350啓動X軸，即使我沒有在Y的左邊值這個畫面軸（在負側）​​。實際上，我想要的是中間的Y軸，即使繪圖值是正值（最大X值和最小X值朝向Y軸之間的對稱性）。 你能告訴我，如果有可能，給我一些例子？

Answer 1

嗨，你可以嘗試這樣的事：

Dim dMinValue as Double, dMaxValue as Double 

With PPSChart 
    dMinValue = application.WorksheetFunction.Min("='" & _ 
        shInfo.Name & "'!R" & RowCount - UBound(tests) - 1 _ 
        & "C" & CInt(4 * (col + 1) - 2) & ":R" & RowCount - 1 _ 
        & "C" & CInt(4 * (col + 1) - 2)) 

    dMaxValue = application.WorksheetFunction.Max("='" & _ 
        shInfo.Name & "'!R" & RowCount - UBound(tests) - 1 _ 
        & "C" & CInt(4 * (col + 1) - 2) & ":R" & RowCount - 1 _ 
        & "C" & CInt(4 * (col + 1) - 2)) 
    .... 
    .Axes(xlValue).MinimumScale = dMinValue 
    .Axes(xlValue).MaximumScale = dMaxValue 
    .... 
End With 

我的建議，你應該指定你的一系列值的一個對象，方便使用

Dim rSerie as Range 
Set rSerie = Range("='" & _ 
         shInfo.Name & "'!R" & RowCount - UBound(tests) - 1 _ 
         & "C" & CInt(4 * (col + 1) - 2) & ":R" & RowCount - 1 _ 
         & "C" & CInt(4 * (col + 1) - 2))) 

With .... 
    dMinValue = Application.WorksheetFunction.Min(rSerie) 
    .... 
End with 

Answer 2

Sub AddChartObject() 
    Dim myChtObj As ChartObject 

    Set myChtObj = ActiveSheet.ChartObjects.Add _ 
     (Left:=100, Width:=375, Top:=75, Height:=225) 
    myChtObj.Chart.SetSourceData Source:=Sheets("Sheet1").Range("A3:G14") 
    myChtObj.Chart.ChartType = xlXYScatterLines 

    ' delete random series that might be generated 
    For Each mySeries In myChtObj.Chart.SeriesCollection 
     mySeries.Delete 
    Next mySeries 

    ' add series 
    Set mySeries = myChtObj.Chart.SeriesCollection.NewSeries 
    mySeries.XValues = Array(0, 300) 
    mySeries.Values = Array(88, 65) 

    ' rescale axis after adding series 
    With myChtObj.Chart.Axes(xlCategory) ' otherwise can use ActiveSheet.ChartObjects(1).Chart.Axes(xlCategory) 
     .MinimumScale = -350 'ActiveSheet.Range("C33").Value 
     .MaximumScale = 350 'ActiveSheet.Range("D54").Value 
    End With 
End Sub