AW: Filter in diagrammen automatisieren
19.04.2015 13:03:27
Nepumuk
Hallo,
dann teste mal:
Option Explicit
Private Sub Worksheet_Activate()
Dim objPivotItem As PivotItem
Dim lngIndex As Long
Dim blnFound As Boolean
Application.ScreenUpdating = False
EnableCalculation = False
For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
With objPivotItem
.Visible = True
If Val(.Value) = Cells(1, 13).Value Then blnFound = True
End With
Next
If blnFound Then
For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
With objPivotItem
.Visible = Val(.Value) = Cells(1, 13).Value
End With
Next
With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
For Each objPivotItem In .PivotItems
objPivotItem.Visible = True
Next
For lngIndex = 1 To .PivotItems.Count - 5
.PivotItems.Item(lngIndex).Visible = False
Next
End With
Else
ChartObjects(1).Select
MsgBox "Der Wert ist nicht in der Liste von Diagramm 1", vbExclamation, "Hinweis"
End If
blnFound = False
For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
With objPivotItem
.Visible = True
If Val(.Value) = Cells(1, 13).Value Then blnFound = True
End With
Next
If blnFound Then
For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
With objPivotItem
.Visible = Val(.Value) = Cells(1, 13).Value
End With
Next
With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
For Each objPivotItem In .PivotItems
objPivotItem.Visible = True
Next
For lngIndex = 1 To .PivotItems.Count - 5
.PivotItems.Item(lngIndex).Visible = False
Next
End With
Else
ChartObjects (2)
MsgBox "Der Wert ist nicht in der Liste von Diagramm 2", vbExclamation, "Hinweis"
End If
blnFound = False
For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
With objPivotItem
.Visible = True
If Val(.Value) = Cells(1, 13).Value Then blnFound = True
End With
Next
If blnFound Then
For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
With objPivotItem
.Visible = Val(.Value) = Cells(1, 13).Value
End With
Next
With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
For Each objPivotItem In .PivotItems
objPivotItem.Visible = True
Next
For lngIndex = 1 To .PivotItems.Count - 5
.PivotItems.Item(lngIndex).Visible = False
Next
End With
Else
ChartObjects (3)
MsgBox "Der Wert ist nicht in der Liste von Diagramm 3", vbExclamation, "Hinweis"
End If
EnableCalculation = True
Application.ScreenUpdating = True
End Sub
Gruß
Nepumuk