自动图表生成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

回答

相关问题