An Franz und andere: Mein Code Pivot geht nicht
Holger,
unten stehender Code funktioniert nicht.
Er sollte die Auswahl eines Bedrichtsfilters in einer Pivottabelle automatisch in alle anderen übertragen.
Wähle ich also in einer Pivottabelle "Holger" aus, sollte auch der Berichtsfilter von allen
anderen automatisch so gesetzt werden. Alle Pivottabelle sind in einem Worksheet.
Das Problem ist, der Berichtsfilter wird überhaupt nicht auf den Wert der ersten PivotTabelle angepasst.
Wenn ich das mit dem Recorder aufzeichne, kommt auc ganz was anderes raus von den Befehlen.
Diese gehen aber leider nicht in einer Prozedur, da kommt immer ein Fehler.
Kann jemand bitte helfen?
Private Sub recorder()
ActiveSheet.PivotTables("PivotTable15").PivotFields("Period").ClearAllFilters
ActiveSheet.PivotTables("PivotTable15").PivotFields("Period").CurrentPage = _
"2010-01"
End Sub
Das ist meine Prozedur:Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ptItem As PivotItem, ptItem2 As PivotItem
Dim ptTable As PivotTable
Dim ptField As PivotField, ptfield2 As PivotField
Dim strPiName As String, strPtName As String
Application.EnableEvents = False
'"Hallo"
Set ptField = Target.PivotFields("Period")
strPtName = Target.Name
For Each ptItem In Target.PivotFields("Period").PivotItems
If ptItem.Name "(blank)" Then
If ptItem.Visible = True And ptItem.Name "" Then
strPiName = ptItem.Name
Exit For
MsgBox strPiName
End If
End If
Next ptItem
With ActiveSheet
For Each ptTable In .PivotTables
If ptTable.Name strPtName Then
Set ptfield2 = ptTable.PivotFields("Period")
For Each ptItem2 In ptfield2.HiddenItems
If ptItem2.Name = strPiName Then
ptItem2.Visible = True
Exit For
End If
Next ptItem2
For Each ptItem2 In ptfield2.VisibleItems
If ptItem2.Name strPiName Then
ptItem2.Visible = False
End If
Next ptItem2
End If
ptTable.RefreshTable
Next ptTable
End With
Application.EnableEvents = True
End Sub