Get filters of pivot table fields

[arianevergauwen]

Hello,

I want to make a macro that loop thru the fields of a pivot table and get all filtervalues of each fields (in a array).
I already have some code but it gives errors with row- and columnfields an with hierachy filterfields .

Function SubScanPivot(Par_Pivot As String, Par_Pivotsheet As String) As Boolean
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim pvt As PivotTable
    Dim Filter() As Variant
    Dim pvt_field_name As String


    SubScanPivot = True
    
    Set Wb = Workbooks(gblWorkbookName)


    For Each pvt_field In Worksheets(Par_Pivotsheet).PivotTables(Par_Pivot).PivotFields
        blnOK = False
        
        '1 = RowField // 2 = ColomnField // 3 = FilterField // 4 = MeasuresField
        
        If pvt_field.Orientation = 1 Or _
            pvt_field.Orientation = 2 Or _
            pvt_field.Orientation = 3 Then
            pvt_field_name = pvt_field.Name
            
            Filter = Workbooks(gblWorkbookName).Sheets(Par_Pivotsheet).PivotTables(Par_Pivot).PivotFields(pvt_field_name).VisibleItemsList
            
            If Filter(1) = "" Then
                If pvt_field.Orientation <> 1 And pvt_field.Orientation <> 2 Then
                    Filter(1) = Workbooks(gblWorkbookName).Sheets(Par_Pivotsheet).PivotTables(Par_Pivot).PivotFields(pvt_field_name).CurrentPageName
                End If
            End If
            
            If Filter(1) <> "" Then
                If UBound(Filter) > 1 Then
                    For I = 1 To UBound(Filter)
                        DoSomeThing1
                    Next
                ElseIf UBound(Filter) = 1 Then
                    DoSomeThing2
                End If
            End If
        End If
    Next pvt_field
    
    Exit Function
    
err_SubScanPivot:
    MsgBox "Error in SubScanPivot: (" & Err.Number & ") - " & Err.Description
    Resume Next
End Function

Can someone help me?

Grts
Ariane