excel - 在现有图表 vba 中更新或覆盖

Question

大家好，我正在创建一个绘制图表的 vba 代码，我的问题是：我如何更新或覆盖我创建的图表中的 seriescollection 或值，因为每次运行我的 sub 时，如果我运行 sub n 次，它会创建 n 个图形，或者你建议我有什么想法来实现我的目标？感谢你的帮助，这里是代码：

Sub Grafica()
'*** Creación de gráficas
Dim MyChartName As String
Dim CreateChart As Boolean
Dim Graph As ChartObject
Dim doc As Workbook

Set doc = ThisWorkbook
found = False 'buscador de hojas repetidas

With doc 'examina si en el libro hay hojas repetidas'
    For Each ws In doc.Worksheets 'examina en cada hoja de las que hay en el excel local
        If (LCase(ws.Name) = LCase("Series_Graph")) Then
            found = True
            Set ws = ws 'al hallar condición se fija la hoja existente para colocar valor, (creo que con esto sirve para actualizar)
            Exit For
        End If
    Next

    If (Not found) Then 'en caso la hoja no exista crea una nueva con el nombreasignado por defecto: DATA_nombrehojaexaminada
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count))
        ws.Name = "Series_Graph"
    End If

End With


Set Sheetg = doc.Sheets("Series_Graph") 'Hoja de gráfico
MyChartName = "Gráfica 1"
CreateChart = True

If Sheetg.ChartObjects.count > 0 Then
  For Each Graph In Sheetg.ChartObjects
    If Graph.Name = MyChartName Then
      CreateChart = False
      Set Graph = Sheetg.ChartObjects(MyChartName)
    End If
  Next
End If

If CreateChart = True Then
    Set Graph = Sheetg.ChartObjects.Add(Top:=15, Left:=0, Width:=510.236, Height:=1020.47)
    Graph.Name = MyChartName
End If
With Graph.Chart
    '.SetSourceData rng 'Since we already set the range of cells to be used for chart we have use RNG object here
    .ChartType = xlXYScatterLinesNoMarkers
    .HasTitle = True
    .ChartTitle.Text = "IN-GAP-04" & vbCr & _
                            "Eje " & "A" & vbCr & _
                            "Azimut: " & "268.16" & "°"
    .ChartTitle.Font.Name = "Arial"
    .ChartTitle.Font.Color = RGB(0, 0, 0)
    .ChartTitle.Font.Bold = True
    .ChartTitle.Font.Size = 16
    .ChartTitle.HorizontalAlignment = xlHAlignCenterAcrossSelection
    .Axes(xlValue).MinimumScale = Round(((RanArray1(1)(1)) / 2), 0) * 2
    .Axes(xlValue).MaximumScale = Round((RanArray1(1)(0) / 2), 0) * 2
    '.SetElement msoElementPrimaryValueGridLinesNone
    .Axes(xlValue).TickLabels.Font.Name = "Arial"
    '.Axes(xlXValue).TickLabels.Font.Name = "Arial"
    .SeriesCollection.NewSeries
    .SeriesCollection(1).Name = "Rango de precisión"
    .SeriesCollection(1).XValues = RanArray1(0)
    .SeriesCollection(1).Values = RanArray1(1)
    .SeriesCollection(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .DashStyle = 3 '3 o msoLineRoundDot cualquiera de las 2 expresiones es valida
        .ForeColor.RGB = RGB(255, 0, 0) 'rojo
        .Weight = 2.25
    End With

End With



Debug.Print Graph.Name
'Debug.Print Round((RanArray1(1)(0) / 2), 0) * 2
'Debug.Print Join(RanArray1(1), ",")

End Sub

标签： excelvbagraphexcel-charts

Answer 1

假设您只有一个图表要显示，您应该删除所有当前现有的图表，然后添加一个将是最新的图表（更新的图表）。在开始格式化图表之前添加以下代码行（下图）

For i = Graph.Chart.SeriesCollection.Count To 1 Step -1
    Graph.Chart.SeriesCollection(i).Delete
Next i

如果您查看当前代码，它会添加一个新系列".SeriesCollection.NewSeries"，但您只更新第一个系列（索引 1）。因此，您可以事先删除所有系列，当您添加新系列时，默认情况下它将是索引 1，一切都应该正常工作。或者你可以做一个 if 语句来检查一个系列是否已经存在，如果是则不需要创建一个新系列。