AW: Aktivierte Filter eines Pivotfeldes anzeigen
16.07.2014 13:20:30
fcs
Hallo Niko,
irgendwo im Pivot-Objektmodell hat Microsoft noch einen Bug eingebaut für das Item "(Leer")".
Dieses läßt sich nicht immer korrekt auswerten oder es wird "(blank)". Man könnte zwar noch ein paar Klimmzüge machen und die "DataRange" des Berichtsfeldes auswerten, aber 100% kriegt man da auch nicht hin und man muss dann auch noch die Sprache berücksichtigen.
Nachfolgend eine Function, die das per Parameter übergebene Feld auswertet, und ein Ereignismakro, das nach einer Aktualisierung der Pivottabelle gestartet wird.
Gruß
Franz
'Erstellt unter Excel 2010
'Code in einem allgemeinen Modul
Function fncBerichtsfilter(pvTable As PivotTable, strFieldName As String, _
Optional strSep As String = " | ") As String
'Zusammenstellen der selectierten Items im 1. Berichtsfeld eines Pivot-Tabellenberichts
Dim pvField As PivotField, pvItem As PivotItem
'Seitenfeld-Filter auslesen
Set pvField = pvTable.PageFields(strFieldName)
With pvField
fncBerichtsfilter = ""
If .EnableMultiplePageItems = True Then
For Each pvItem In .PivotItems
If Not IsError(pvItem.SourceName) Then
If pvItem.Visible = True Then
If fncBerichtsfilter = "" Then
fncBerichtsfilter = pvItem.Caption
Else
fncBerichtsfilter = fncBerichtsfilter & strSep & pvItem.Caption
End If
End If
End If
Next
Else
If .CurrentPage = "(Alle)" Or .CurrentPage = "(All)" Then
For Each pvItem In .PivotItems
If fncBerichtsfilter = "" Then
fncBerichtsfilter = pvItem.Caption
Else
fncBerichtsfilter = fncBerichtsfilter & strSep & pvItem.Caption
End If
Next
Else
fncBerichtsfilter = .CurrentPage.Caption
End If
End If
End With
End Function
'Ereignis-Makro unter dem Modul der Tabelle mit dem Pivotbericht
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
With Me
'in nächster Zeile _
- die Zelle (wo Filter eingetragen werden soll), _
- Name des Berichtsfeldes, _
- und ggf. den Trenntext zwischen den Filterwerten _
anpassen.
.Range("B2").Value = fncBerichtsfilter(pvTable:=Target, _
strFieldName:="Feld01", strSep:=";")
End With
End Sub
'PS. sind mehrere Pivottabellen auf dem Tabellenblatt, dann muss _
ggf. eine Prüfung auf den Namen der Pivot-Tabelle eingebaut werden