Как динамически обновить ряд точечной диаграммы с VBA? - PullRequest
Новая
       30

Как динамически обновить ряд точечной диаграммы с VBA?

0 голосов
/ 10 апреля 2020

У меня есть лист с примерно 30 диаграммами, которые я хочу динамически обновлять с помощью макроса VBA. У меня есть некоторые проблемы с обработкой серии, но я не могу понять, в чем дело.

Код должен пройти через несколько диаграмм (только 3 в следующем коде), очистить старое содержимое и добавить 6 новых серий с данными, взятыми из электронной таблицы. Напротив, он не удаляет старые серии и при каждом запуске добавляет их снова с новым, а затем завершает работу с ошибкой «Параметр не действителен» в строке 22. Я боролся за это пару раз. недели, и самая неприятная часть в том, что код - это, в основном, копия + вставка из другого проекта, которая прекрасно работает.

Вот код: 

Public Sub Refresh_NB_Graphs()

    Dim cht As Chart
    Dim chtObj As ChartObject
    Dim vi As Integer
    Dim s As Object
    Dim j As Integer
    Dim k As Integer
    Dim seriesIndex As Integer
    Dim xRange As Range
    Dim yRange As Range

    'Application.ScreenUpdating = False
    On Error GoTo Errorcatch

    'Graph fetching and update cycle
    For vi = 1 To 3
        Set chtObj = Sh_NBGain.ChartObjects("Ch_Gain_Vs" & CStr(vi))
        Set cht = chtObj.Chart
        ' Adding or removing this section makes no difference -------
        For Each s In cht.SeriesCollection
            s.Delete
        Next s
        ' -----------------------------------------------------------
        cht.ChartArea.ClearContents
        'Format Font Type and Size
        cht.ChartType = xlXYScatterLinesNoMarkers                                   ' scatter plot
        cht.ChartArea.Format.TextFrame2.TextRange.Font.Name = "Arial"
        cht.ChartArea.Format.TextFrame2.TextRange.Font.Size = 14
        cht.HasTitle = False      ' No chart title
        ' Add series: data origin in Sh_NBGainProcess
        seriesIndex = 0
        For j = 0 To 5
                seriesIndex = seriesIndex + 1
                cht.SeriesCollection.NewSeries
1               cht.SeriesCollection(seriesIndex).Name = CStr(Sh_Vars.Range("A8").Offset(j, 0).Value)
                Set xRange = Sh_NBGainProcess.Range("C42:C1642").Offset(1600 * (vi - 1), 20 * j)
                Set yRange = Sh_NBGainProcess.Range("D42:D1642").Offset(1600 * (vi - 1), 20 * j)
10              cht.SeriesCollection(seriesIndex).XValues = "='" & Sh_NBGainProcess.Name & "'!" & xRange.Address
20              cht.SeriesCollection(seriesIndex).Values = "='" & Sh_NBGainProcess.Name & "'!" & yRange.Address
22              With cht.SeriesCollection(seriesIndex)
23                  Debug.Print seriesIndex
30                  .Format.Line.Weight = 2.25
40                  .Format.Line.Visible = msoTrue
50                  .Format.Line.ForeColor.RGB = ECOPalette(j)    ' Array with defined colors
60                  .MarkerStyle = xlMarkerStyleNone
                End With
        Next j

        '.....................

     Next vi
End Sub

Кто-нибудь может помочь?

Спасибо!

1 Ответ

0 голосов
/ 16 апреля 2020

Пришлось немного переделать код, но теперь все нормально: 

    Dim cht As Chart
    Dim s As Series
    Dim vi As Integer
    Dim j As Integer
    Dim xRange As Range
    Dim yRange As Range

    'Application.ScreenUpdating = False
    On Error GoTo Errorcatch

    'Graph fetching and update cycle
    For vi = 1 To 3
        ' Gain charts (Vs 1 to 3) ***********************************************************************************************************
        Set cht = Sh_NBGain.ChartObjects("Ch_Gain_Vs" & CStr(vi)).Chart
        ' Clear existing data
        For Each s In cht.SeriesCollection
            s.Delete
        Next s
        cht.ChartArea.ClearContents
        cht.ChartType = xlXYScatterLinesNoMarkers                                   ' scatter plot

        ' Add series: data origin in Sh_NBGainProcess
        For j = 0 To 5
            If Not Sh_NBGainProcess.Range("C42").Offset(1601 * (vi - 1), 20 * j).Value = "" Then
10              Set s = cht.SeriesCollection.NewSeries
40              s.Name = CStr(Sh_Vars.Range("A8").Offset(j, 0).Value)
50              Set xRange = Sh_NBGainProcess.Range("C42:C1642").Offset(1601 * (vi - 1), 20 * j)
60              Set yRange = Sh_NBGainProcess.Range("D42:D1642").Offset(1601 * (vi - 1), 20 * j)
90               s.XValues = "='" & Sh_NBGainProcess.Name & "'!" & xRange.Address
100              s.Values = "='" & Sh_NBGainProcess.Name & "'!" & yRange.Address
110              With s
130                  .Format.Line.Weight = 2.25
140                  .Format.Line.Visible = msoTrue
150                  .Format.Line.ForeColor.RGB = ECOPalette(j)
160                  .MarkerStyle = xlMarkerStyleNone
                End With
            End If
        Next j

Я думаю, что основная проблема была из-за использования индексации коллекций серий, которая как-то плохо себя вел (до сих пор не понимаю почему). При прямой ссылке на объект серии при его создании с помощью Set s = cht.SeriesCollection.NewSeries все go отлично.

...