Marcar vários filtros na tabela dinâmica automaticamente – VBA
Objetivo: Marcar vários filtros na tabela dinâmica automaticamente – VBA.
Esta planilha foi criada pelo meu amigo Edney Nascimento, ao qual agradeço pela colaboração com o site.
A planilha consiste em marcar nas checkbox as marcações dos dias nas tabelas dinâmicas de forma automática.
Abaixo o código fonte:
Sub AtualizarDia() On Error GoTo ErroAtualizarDia Dim PrimeiraLinhaDW As Long, UltimaLinhaDW As Long, NomeTabelaDW As String PrimeiraLinhaDW = 2 UltimaLinhaDW = Sheets("PARAMETROS").Cells(2, 1).End(xlDown).Row 'Executa o processo conforme a quantidade de tabelas dinâmicas existentes For i = PrimeiraLinhaDW To UltimaLinhaDW NomeTabelaDW = Sheets("PARAMETROS").Cells(i, 1).Text 'Atualiza a tabela dinâmica somente na 1ª vez que o processo é executado If i = 2 Then ActiveSheet.PivotTables(NomeTabelaDW).PivotCache.Refresh End If 'Limpa os filtros ActiveSheet.PivotTables(NomeTabelaDW).PivotFields("Dia").ClearAllFilters 'Executa o processo para cada um dos dias do mês For j = 1 To 31 ActiveSheet.PivotTables(NomeTabelaDW).PivotFields("DIA").PivotItems(j).Visible = Worksheets("PARAMETROS").Cells(j + 1, 6).Value Next j Next i Fim: Exit Sub ErroAtualizarDia: If Err.Number = 1004 Then Resume Next Else Mensagem = Err.Number & " " & Err.Description MsgBox Mensagem, vbInformation, Titulo End If End Sub Sub MarcarTudo() For i = 2 To 32 Sheets("PARAMETROS").Cells(i, 5).Value = True Next i End Sub Sub DesmarcarTudo() For i = 2 To 32 Sheets("PARAMETROS").Cells(i, 5).Value = False Next i End Sub
DIGITE O SEU EMAIL PARA FAZER O DOWNLOAD DOS ARQUIVOS: Baixe a planilha
Abraço
Marcos Rieper