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

Question

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

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

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

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

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

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

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

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

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

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

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

Answer 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 заключается в том, что вам не нужно компенсировать пропущенные элементы каждый раз, когда вы удаляете вещи: с любыми перенумерованными элементами уже обращались, и больше не имеет значения, какое они число.

Заявка.WorksheetFunction.Макс находит самое высокое значение из серии

    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