自動圖表生成VBA

我想在我創建的圖表中自動生成新系列。自動圖表生成VBA

我有一個矢量P(m)從1到n_r。此向量在for循環中的「時間步驟」中更新，該循環從1到Ntime（j計數器變量，如下面的代碼所示）我想在每次增加j時在同一圖表中創建新系列，最好是「用直線分散」圖表。

for j = 1 to Ntime  
    for m = 1 to n_r 
     'calculating the vector P(m)  
    next m 

    'code below writes vector P(m) to new columns for every new time step 
    'stating in column D  
    For m = 1 To n_r 
     Cells(2 + m, 3 + j) = P(m) 
    Next m 
Next j

我的P（M）的向量寫入到在下面的圖中所示的細胞，一列寫入到正確的每一個新的Ĵ

其中我要添加更多系列的圖表中示出如下：在此問題上的任何幫助，不勝感激

來源

2017-04-05 Eirik

其中是創建「圖表」和「SeriesCollection」的相關代碼？ –

該圖表已創建不使用宏。我對VBA編程相當陌生，所以不確定SeriesCollection是什麼。抱歉。我想添加新系列的圖表位於另一張名爲Prt – Eirik

的圖表中可能會添加現有圖表的屏幕截圖，以及您想從中獲取數據的位置以添加更多「系列」（而不是完全相反你在哪裏'P（m）'vector？ –

幾天前我有同樣的問題。我使用下面的代碼。

這不是直接回答你的問題，但你可以用它作爲一個起點。

我的代碼創建四個散點圖（InsertOptionChart稱爲四次），並且對於每個散點圖，它一個接一個增加dataseries並設置其格式（標記，線等）

Option Explicit 

Public Sub InsertOptionChartWrapper() 
    Dim ewsOption As Worksheet: Set ewsOption = ThisWorkbook.Worksheets("Option") 
    Dim r As Long: For r = 0 To 3 
     InsertOptionChart _ 
      ewsOption.Range("B30:S65").Offset(37 * r, 0), _ 
      ewsOption.Range("BD179:CC179").Offset(25 * r, 0), _ 
      ewsOption.Range("BD180:CC180").Offset(25 * r, 0), _ 
      ewsOption.Range("B182:B202").Offset(25 * r, 0), _ 
      ewsOption.Range("BD182:CC202").Offset(25 * r, 0) 
    Next r 
End Sub 

Public Sub InsertOptionChart(rngPlace As Range, rngParty As Range, rngOptionName As Range, rngRisk As Range, rngEv As Range) 
    Dim chtTarget As Chart: Set chtTarget = rngParty.Worksheet.ChartObjects.Add(rngPlace.Left, rngPlace.Top, rngPlace.Width, rngPlace.Height).Chart 
    chtTarget.ChartType = xlXYScatterSmooth 

    Dim c As Long: For c = 1 To rngParty.Columns.Count 
     Dim serActual As Series: Set serActual = chtTarget.SeriesCollection.NewSeries() 
     serActual.XValues = rngRisk 
     serActual.Values = rngEv.Columns(c) 
     serActual.Name = rngParty.Cells(1, c) & " " & rngOptionName.Cells(1, c) 

     serActual.Format.Line.Visible = msoFalse 
     serActual.Format.Line.Visible = msoTrue 
     serActual.Format.Line.Weight = 1 

     serActual.MarkerSize = 5 
     If rngParty.Cells(1, c).Value = "MT" Then 
      serActual.MarkerStyle = xlMarkerStyleCircle 
     Else 
      serActual.MarkerStyle = xlMarkerStylePlus 
     End If 

     Select Case Left(rngOptionName.Cells(1, c).Value, 1) 
     Case "S" ' Spot 
      serActual.MarkerForegroundColor = RGB(0, 0, 0) 
     Case "A" 
      serActual.MarkerForegroundColor = RGB(237, 169, 90) 
     Case "B" 
      serActual.MarkerForegroundColor = RGB(159, 76, 151) 
     Case "C" 
      serActual.MarkerForegroundColor = RGB(100, 185, 228) 
     Case "D" 
      serActual.MarkerForegroundColor = RGB(64, 143, 154) 
     Case "N" ' None 
      serActual.MarkerForegroundColor = RGB(226, 0, 116) 
     End Select 

     Select Case Right(rngOptionName.Cells(1, c).Value, 4) 
     Case "2019" 
      serActual.Format.Line.DashStyle = msoLineSolid 
     Case "2020" 
      serActual.Format.Line.DashStyle = msoLineLongDash 
     Case "2021" 
      serActual.Format.Line.DashStyle = msoLineDash 
     Case "2022" 
      serActual.Format.Line.DashStyle = msoLineSquareDot 
     Case Else 
      serActual.Format.Line.DashStyle = msoLineSolid 
     End Select 

     serActual.MarkerBackgroundColorIndex = 2 
     serActual.Format.Line.ForeColor.RGB = serActual.MarkerForegroundColor 
    Next c 

    chtTarget.Axes(xlValue).MajorGridlines.Delete 
    chtTarget.Axes(xlValue).TickLabelPosition = xlLow 
    chtTarget.Axes(xlCategory).MajorGridlines.Delete 
    chtTarget.Axes(xlCategory).TickLabelPosition = xlLow 

    chtTarget.Legend.Font.Size = 8 
    chtTarget.Legend.Top = 0 
    chtTarget.Legend.Height = chtTarget.Parent.Height 
End Sub

來源

2017-04-06 10:35:11 z32a7ul

非常感謝！這對我有很大的幫助:) – Eirik

自動圖表生成VBA

回答

相關問題