Excel 2013 - удаление объектов LegendEntry из легенды сводной диаграммы с использованием VBA

У меня есть сводная диаграмма, которая обычно показывает 6-8 серий из 15 возможных, многие из которых, как правило, равны нулю. Таким образом, каждый раз, когда он обновляется, у него есть 15 серий, и в Legend нужно всего лишь перечислить серии с ненулевыми цифрами, чтобы диаграмма была загромождена и легко читалась.

Я пытаюсь использовать VBA для удаления определенных элементов, где все серии равны нулю (максимальное значение = 0), и обнаружил больше проблем, чем ожидалось:

  1. Я перебираю каждый элемент из коллекции Chart's FullSeriesCollection, перебирая список серий один за другим. Однако, поскольку Легенда - это отдельный объект от Серии, вы не можете использовать текущую серию из моего цикла для ссылки на нее, и поэтому требует счетчика цикла.

  2. Нет никакого способа узнать имя / значение элемента LegendEntries, поэтому вы должны сопоставить Series с легендой, не имея возможности подтвердить, какой элемент LegendEntries какой.

(очевидно, ниже функция присутствует в Excel 2007 и далее?)

  1. Похоже, что объект FullSeriesCollection упорядочивает элементы (разумно) от 1 до 13 при их цикле, но объект LegendEntries упорядочивает элементы в обратном порядке, с 13 до 1.

  2. Объект LegendEntries начинает свой индекс с 0, поэтому его элементы фактически упорядочены от 12 до 0.

  3. Объект LegendEntries пересчитывает свои элементы при удалении из него. Поэтому, когда вы удаляете элемент 1, все элементы в списке нумеруются с 11 до 0.

  4. Мне нужно обновлять диаграмму каждый раз, когда обновляется сводная таблица, чтобы перехватывать все удаленные элементы LegendEntries, которые теперь могут быть ненулевыми.

В свете этих осложнений я действительно изо всех сил пытался удалить конкретные элементы, которые мне нужно удалить из таблицы.

Как вы эффективно просматриваете элементы сводной таблицы и удаляете соответствующие серии LegendEntries везде, где все элементы равны нулю?

Источник

1 ответ

Решение

Начните с события Worksheet_PivotTableUpdate

Рабочий лист, в котором находится сводная таблица, нуждается в следующем коде, поэтому он вызывает новую функцию RefreshAbsenceLabels в модуле 1 всякий раз, когда обновляется эта специально названная сводная таблица:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

If Target.Name = "This Specific Table" Then

    Module1.RefreshAbsenceLabels
    MsgBox "The PivotTable has been updated."

End If

End Sub

Поговорите с правым графиком и обновите его Легенду 

Public Function RefreshAbsenceLabels()

Set DaysAbsent = ActiveWorkbook.Worksheets("Dashboard").ChartObjects("Department Absences")

With DaysAbsent.Chart

    If .HasLegend Then
        .HasLegend = False
    End If
    .HasLegend = True

Настройте свой счетчик, и установите его на счет серии минус один

минус один - это учет того факта, что коллекция FullSeriesCollection пронумерована от 1 до X, а элементы LegendEntries пронумерованы от X-1 до 0

    Dim x As Integer
    x = .FullSeriesCollection.Count - 1

Цикл по серии, удаление соответствующих элементов LegendEntries

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

Application.WorksheetFunction.Max находит наибольшее значение из серии

    For Each ser In .FullSeriesCollection

        If Application.WorksheetFunction.Max(ser.Values) = 0 Then
            'MsgBox "Deleting" & ser.Name & " - " & x
            .Legend.LegendEntries(x).Delete
        End If

        x = x - 1
    Next
End With
End Function
Источник
Другие вопросы по тегам