Excel 2013 - removendo objetos LegendEntry de uma legenda de gráfico dinâmico usando o VBA

Question

Eu tenho um gráfico dinâmico que normalmente mostra 6-8 séries de possíveis 15, muitos dos quais tendem a ser zero. Assim, toda vez que ele é atualizado, ele tem 15 séries e o Legend só precisa listar a série com números diferentes de zero, para manter o gráfico organizado e fácil de ler.

Estou tentando usar o VBA para excluir itens específicos onde quer que a série esteja toda zerada (valor máximo = 0) e tenha encontrado mais problemas do que o esperado:

1. Estou fazendo um loop em todos os itens da FullSeriesCollection do Chart, avançando na lista de séries, uma a uma. No entanto, como a legenda é um objeto separado da série, você não pode usar a série atual do meu loop para se referir a ela e, assim, exigir um contador de loop .

2. Não há nenhuma maneira de descobrir o nome / valor de um item LegendEntries , então você deve combinar a série com a legenda sem poder confirmar qual item de LegendEntries é qual

(aparentemente, o recurso abaixo está presente no Excel 2007 em diante?)

3. Parece que o objeto FullSeriesCollection ordena os itens (sensatamente) de 1 a 13 conforme você passa por eles, mas o objeto LegendEntries ordena itens em reverso, de 13 a 1 .

4. O objeto LegendEntries inicia seu índice em 0, então seus itens são realmente ordenados de 12 para 0 .

5. O objeto LegendEntries renumera seus itens à medida que você os exclui . Portanto, quando você excluir o item 1, todos os itens da lista serão renumerados de 11 para 0.

6. Eu preciso atualizar o gráfico toda vez que a Tabela Dinâmica for atualizada , para capturar novamente todos os itens de LegendEntries excluídos que agora podem ser diferentes de zero.

À luz dessas complicações, eu realmente lutei para excluir os itens específicos que preciso remover do gráfico.

Como você efetivamente percorre os itens de uma Tabela Dinâmica e exclui as séries LegendEntries correspondentes sempre que os itens são todos zero?

    

Answer 1

Comece com o evento Worksheet_PivotTableUpdate

A planilha que abriga a Tabela Dinâmica precisa do código a seguir, de forma que chame a nova função 'RefreshAbsenceLabels' no Módulo 1 sempre que essa Tabela Dinâmica especificamente nomeada for atualizada:

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

Fale com o gráfico certo e atualize sua Legenda

Public Function RefreshAbsenceLabels()

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

With DaysAbsent.Chart

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

Configure seu contador e configure-o para a contagem da série menos um

o menos um é responsável pelo fato de que o FullSeriesCollection é numerado de 1 a X, enquanto os itens de LegendEntries são numerados de X-1 a 0

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

Faz um loop por uma série, excluindo itens LegendEntries correspondentes

O contador desce para zero. A vantagem da numeração reversa da LegendEntries é que você não precisa compensar por itens perdidos toda vez que você apaga coisas: quaisquer itens renumerados já foram tratados, e não importa mais o número deles.

Application.WorksheetFunction.Max encontra o maior valor da série

    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