[es] - VBA da uradi Collapse/Expand All tabela u PivotTable Fields Pane-u

bokinet

Član broj: 29844
Poruke: 574

+50 Profil

Re: VBA da uradi "Collapse/Expand All" tabela u PivotTable Fields Pane-u

^{25.11.2021. u 19:56 - pre 29 meseci}

Vec je neko pisao na google-u pa da se ne ponavljam

www.excelcampus.com/vba/expand...re-pivot-table-fields-buttons/

The VBA Macro Code
There are four different macros for the expand/collapse on the Rows and Columns areas. The macros use For Next Loops to do some pretty aggressive looping through the pivot fields and items.

The Expand macro finds the field in the highest position that is collapsed by checking the ShowDetail property of each PivotItem. If it does NOT find an expanded item, then it expands the entire field. If all items are expanded, then it proceeds to the field in the next position down.

Code:

Sub Expand_Entire_RowField()
'Expand the lowest position field in the Rows area
'that is currently expanded (showing details)

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim iFieldCount As Long
Dim iPosition As Long

  'Create reference to 1st pivot table on sheet
  'Can be changed to reference a specific sheet or pivot table.
  Set pt = ActiveSheet.PivotTables(1)

  'Count fields in Rows area minus 1 (last field can't be expanded)
  iFieldCount = pt.RowFields.Count - 1

  'Loop by position of field
  For iPosition = 1 To iFieldCount
    'Loop fields in Rows area
    For Each pf In pt.RowFields
      'If position matches first loop variable then
      If pf.Position = iPosition Then
        'Loop each pivot item
        For Each pi In pf.PivotItems
          'If pivot item is collapsed then
          If pi.ShowDetail = False Then
            'Expand entire field
            pf.ShowDetail = True
            'Exit the macro
            Exit Sub
          End If
        Next pi
      End If
    Next pf
  'If the Exit Sub line is not hit then the
  'loop will continue to the next field position
  Next iPosition

End Sub

The Collapse macro does the opposite. It starts at the lowest field position and works backwards until it finds a pivot item that is NOT collapsed. If it finds an expanded item then it collapses the entire field. Otherwise it moves up to the field in the next position in the Rows area, and repeats the process.

Code:

Sub Collapse_Entire_RowField()
'Collapse the lowest position field in the Rows area
'that is currently expanded (showing details)

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim iFieldCount As Long
Dim iPosition As Long

  'Create reference to 1st pivot table on sheet
  'Can be changed to reference a specific sheet or pivot table.
  Set pt = ActiveSheet.PivotTables(1)

  'Count fields in Rows area minus 1 (last field can't be expanded)
  iFieldCount = pt.RowFields.Count - 1

  'Loop backwards by position of field (step -1)
  For iPosition = iFieldCount To 1 Step -1
    'Loop fields in Rows area
    For Each pf In pt.RowFields
      'If position matches first loop variable then
      If pf.Position = iPosition Then
        'Loop each pivot item
        For Each pi In pf.PivotItems
          'If pivot item is expanded then
          If pi.ShowDetail = True Then
            'Collapse entire field
            pf.ShowDetail = False
            'Exit the macro
            Exit Sub
          End If
        Next pi
      End If
    Next pf
  'If the Exit Sub line is not hit then the
  'loop will continue to the next field position
  Next iPosition

End Sub

Na kraju od ove dve moze da se napravi jedna f-ja gde ce se za ulaznu vrednost samo birati da li je ExpandAll ili ne.

Odgovor na temu