vba get pivot taable settings code example

Example: vba get pivot taable settings

Sub OptionSet_Short()
'short list of option settings
'select a pivot table cell
' before running this macro
Dim wsList As Worksheet
Dim ws As Worksheet
Dim pt As PivotTable
Dim OptList As ListObject

Dim i As Long   'row number
Dim OptID As Long
Dim strTab As String
'Dim strSF As String
'Dim strMI As String

On Error Resume Next
Set ws = ActiveSheet
Set pt = ActiveCell.PivotTable

If pt Is Nothing Then
  MsgBox "Please select a pivot table cell"
  GoTo exitHandler
End If
Application.EnableEvents = False

Set wsList = Worksheets.Add
i = 3   'leave rows for sheet heading
OptID = 1

With wsList
  'Table Headings
  .Cells(i, 1).Value = "ID"
  .Cells(i, 2).Value = "Tab Name"
  .Cells(i, 3).Value = "Option"
  .Cells(i, 4).Value = "Setting"
  i = i + 1
  
  '----------------
  'Tab 1
  strTab = "Layout & Format"
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Autofit column widths on update"
  .Cells(i, 4).Value = pt.HasAutoFormat
  i = i + 1
  OptID = 1 + 1
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Preserve cell formatting on update"
  .Cells(i, 4).Value = pt.PreserveFormatting
  i = i + 1
  OptID = 1 + 1
  
  '----------------
  'Tab 2
  strTab = "Totals & Filters"
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Show grand totals for rows"
  .Cells(i, 4).Value = pt.RowGrand
  i = i + 1
  OptID = 1 + 1
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Show grand totals for columns"
  .Cells(i, 4).Value = pt.ColumnGrand
  i = i + 1
  OptID = 1 + 1
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Allow multiple filters per field"
  .Cells(i, 4).Value = pt.AllowMultipleFilters
  i = i + 1
  OptID = 1 + 1
  
  '----------------
  'Tab 3
  strTab = "Display"
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Show expand/collapse buttons"
  .Cells(i, 4).Value = pt.ShowDrillIndicators
  i = i + 1
  OptID = 1 + 1
   
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Show contextual tooltips"
  .Cells(i, 4).Value = pt.DisplayContextTooltips
  i = i + 1
  OptID = 1 + 1
   
  '----------------
  'Tab 4
  strTab = "Printing"
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Set print titles"
  .Cells(i, 4).Value = pt.PrintTitles
  i = i + 1
  OptID = 1 + 1
  
  '----------------
  'Tab 5
  strTab = "Data"
    
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Save source data with file"
  .Cells(i, 4).Value = pt.SaveData
  i = i + 1
  OptID = 1 + 1
  
  .Cells(i, 1).Value = OptID
  .Cells(i, 2).Value = strTab
  .Cells(i, 3).Value = "Refresh data when opening the file"
  .Cells(i, 4).Value = pt.PivotCache.RefreshOnFileOpen
  i = i + 1
  OptID = 1 + 1
    
  '----------------

  'format the options list as table
   Set OptList = .ListObjects.Add(xlSrcRange, _
      .Range("A3").CurrentRegion, , xlYes)
    'OptList.TableStyle = "TableStyleLight8"
    .Columns("A:D").EntireColumn.AutoFit
  
  'Sheet Heading
  .Cells(1, 1).Value = "PIVOT TABLE OPTIONS - " & pt.Name
  .Cells(1, 1).Font.Bold = True
  i = i + 2

End With

exitHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub