Фильтр справочной таблицы - PullRequest
Новая
       26

Фильтр справочной таблицы

1 голос
/ 22 января 2020

Я пытаюсь сослаться на фильтр таблицы PIVOT для использования в качестве имени Сохранить как для создания PDF. Я не могу найти какую-либо комбинацию ссылки на объект таблицы PIVOT для этого. 

Sub Deferred_Rent_To_PDF()

Dim strWorksheet As String
Dim strPivotTable As String
Dim pdfFilename As Variant
Dim strDocName As String
Dim ptDeferredRent As pivotTable

strWorksheet = "Deferred"
strPivotTable = "DeferredRent" 

Set ptDeferredRent = Worksheets(strWorksheet).PivotTables(strPivotTable)
'strDocName = ptDeferredRent.                  <----- THIS IS WHERE I NEED HELP

pdfFilename = Application.GetSaveAsFilename(InitialFileName:=strDocName, _
    FileFilter:="PDF, *.pdf", Title:="Save As PDF")

    If pdfFilename <> False Then

    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=pdfFilename, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    End If

End Sub

1 Ответ

1 голос
/ 22 января 2020

Попробуйте что-то вроде этого:

Вы ищете field_name.CurrentPage, но только если field_name.Orientation = xlPageField (то есть поле фильтра, а не строка или поле данных или столбца или скрытое) 

Sub Deferred_Rent_To_PDF()

Dim strWorksheet As String
Dim strPivotTable As String
Dim pdfFilename As Variant
Dim strDocName As String
Dim ptDeferredRent As PivotTable

strWorksheet = "Pivot (2)" '"Deferred"
strPivotTable = "PivotTable7" '"DeferredRent"

ThisWorkbook.Sheets(strWorksheet).Activate

Set ptDeferredRent = Worksheets(strWorksheet).PivotTables(strPivotTable)
'strDocName = ptDeferredRent.                  <----- THIS IS WHERE I NEED HELP

strDocName = Get_Pivot_filter_field(ptDeferredRent)

If strDocName <> "not found" Then
    Debug.Print strDocName

    pdfFilename = Application.GetSaveAsFilename(InitialFileName:=strDocName, _
        FileFilter:="PDF, *.pdf", Title:="Save As PDF")

        If pdfFilename <> False Then

        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=pdfFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
        End If
End If

End Sub

Function Get_Pivot_filter_field(pvt As PivotTable)

    'On Error Resume Next

    Debug.Print pvt.Name
    Pivot_Table_Name = pvt.Name
    Debug.Print pvt.PivotFields.Count

    Get_Pivot_filter_field = "not found"

    For Each field_name In pvt.VisibleFields 'pvt.PivotFields
        If pivot_field_active(Pivot_Table_Name, field_name) Then

            With field_name

                Debug.Print field_name & " " & .Orientation

                If .Orientation = xlPageField Then 'xlDataField (4)' 'xlColumnField (2)' 'xlHidden (0)' 'xlPageField (3)' 'xlRowField (1)'

                    Debug.Print field_name & " " & .Orientation & .CurrentPage
                    Get_Pivot_filter_field = .CurrentPage

                Else
                    Debug.Print field_name & " not filter field"
                End If
            End With
        Else
            Debug.Print field_name & " not active"
        End If
    Next

End Function

Function pivot_field_active(ByVal Pivot_Table_Name As String, ByVal strName As String) As Boolean

    Dim strTemp As String
    On Error Resume Next
    With ActiveSheet.PivotTables(Pivot_Table_Name).PivotFields(strName)
        If .NumberFormat = "$#,##0" Then
            'Do nothing no error
        End If
        If .CurrentPage Then
            Err.Clear
        End If
    End With
    If Err = 0 Then pivot_field_active = True Else pivot_field_active = False

End Function

Что я здесь делаю, так это l oop через все pvt.VisibleFields, где pvt - это сводная таблица, которую вы передаете в функцию pvt.VisibleFields(pvt)

If .Orientation = xlPageField, тогда это поле фильтра, и если оно затем верните .CurrentPage как результат функции Get_Pivot_filter_field в противном случае верните "not found"

Затем используйте это .CurrentPage в качестве имени PDF.

Полный пример здесь: https://drive.google.com/file/d/1HkeJVgKeFeCuj2ItRn2s90ozy41zlCVL/view?usp=sharing

...