Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1192to1196
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

An Franz und andere: Mein Code Pivot geht nicht

An Franz und andere: Mein Code Pivot geht nicht
Holger,
Hallo,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
WEN ES INTERESSIERT: Code zum Setzen von Filter
05.01.2011 14:23:02
Filter
Hallo,
also es ist echt seltsam.
Ein wesentlich einfacherer Code führt zum Erfolg.
Wird in einem Berichtsfilter etwas ausgewählt, werden automatisch alle anderen
Berichtsfilter der anderen PivotTabellen harmonisiert.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ptItem As PivotItem
Dim strTick As String
Dim i As Integer
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each ptItem In Target.PivotFields("Period").PivotItems
If ptItem.Name  "(blank)" Then
If ptItem.Visible = True And ptItem.Name  "" Then
strTick = ptItem.Name
Exit For
End If
End If
Next ptItem
For i = 1 To ActiveSheet.PivotTables.Count
ActiveSheet.PivotTables(i).PivotFields("Period").ClearAllFilters
ActiveSheet.PivotTables(i).PivotFields("Period").CurrentPage = _
strTick
Next i
ActiveSheet.Columns("A:CG").AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige