Я получаю ошибку для своего кода "Ошибка выполнения 424" - PullRequest
0 голосов
/ 18 января 2019

Мой код работает нормально, но в итоге он выдавал объект "ошибка времени выполнения".

Я не могу выяснить, что является причиной этой ошибки. Этот код связан с удалением графиков, в которых нет данных.

Sub HideEmptyCharts()
    Dim wksCharts As Worksheet
    Dim objCO As ChartObject

    ' Set up a variable for the worksheet containing the charts
    Set wksCharts = ThisWorkbook.Sheets("Report output")

    ' Loop through every embedded chart object on the worksheet
    For Each objCO In wksCharts.ChartObjects
        ' Make each one visible
        objCO.Visible = True

        ' If the chart is empty make it not visible
        If IsChartEmpty(objCO.Chart) Then objCO.Visible = False
    Next objCO
End Sub

Private Function IsChartEmpty(chtAnalyse As Chart) As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim objSeries As Series

    ' Loop through all series of data within the chart
    For i = 1 To chtAnalyse.SeriesCollection.Count
        Set objSeries = chtAnalyse.SeriesCollection(i)

        ' Loop through each value of the series
        For j = 1 To UBound(objSeries.Values)
            ' If we have a non-zero value then the chart is not deemed to be empty
            If objSeries.Values(j) <> 0 Then
                ' Set return value and quit function
                IsChartEmpty = False
                Exit Function
            End If
        Next j
    Next i

    IsChartEmpty = True
End Function

error image

Ответы [ 2 ]

0 голосов
/ 21 января 2019

Изменить объект, передаваемый в функцию, с Chart на полный ChartObject следующим образом:

Private Sub HideEmptyCharts()
    Dim wksCharts As Worksheet
    Dim objCO As ChartObject

    Set wksCharts= ThisWorkbook.Sheets("Report output")
    For Each objCO In wksCharts.ChartObjects
        objCO.Visible = True
        If IsChartEmpty(objCO) Then objCO.Visible = False
    Next objCO
End Sub


Private Function IsChartEmpty(co As ChartObject) As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim objSeries As Series
    For i = 1 To co.Chart.SeriesCollection.Count
        Set objSeries = co.Chart.SeriesCollection(i)
        For j = 1 To UBound(objSeries.Values)
            If objSeries.Values(j) <> 0 Then
                IsChartEmpty = False
                Exit Function
            End If
        Next j
    Next i
    IsChartEmpty = True
End Function
0 голосов
/ 18 января 2019

Устаревший сводный кеш и некоторые все еще помнят, но в то же время пропущенные вещи вызывали у меня некоторые проблемы в прошлом. Поэтому я предлагаю добавить этот код один раз до:

Dim pc As PivotCache
For Each pc In ThisWorkbook.PivotCaches
    pc.MissingItemsLimit = xlMissingItemsNone
    pc.Refresh
Next pc
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...