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

Answer 1

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

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

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

更新或覆盖现有图表VBA

1 个答案: