Try this...
Option Explicit
'

'/================================================/
Sub Pivot_Properties()
 'Creates a worksheet within the current workbook
 ' listing pivot table information
 'Creates a comment on each pivot table containing an
 ' abbreviated version of that information
 Dim aryHiddensheets()
 Dim blnColFields As Boolean, blnShowValues As Boolean
 Dim blnMakeComment As Boolean
 Dim d As Double, c As Double
 Dim i As Long, z As Long, iPtCount As Long
 Dim x As Long, y As Long, w As Long
 Dim iFieldsCount As Long
 Dim iRow As Long, iColumn As Long
 Dim iWorksheets As Long
 Dim objCalcItem As Object
 Dim objCubeFld As Object
 Dim objPvtField As Object
 Dim objOutputArea As Object
 Dim objSheet As Object
 Dim strAnswer As String, strComment As String
 Dim strResultsTableName As String
 Dim varAnswer As Variant
 Dim varPvtField As Variant, varPivotItem As Variant

 On Error Resume Next

 '/- - - - Variables - - - - - - - -
 strResultsTableName = "PivotTableProperties"
 strAnswer = ""
 strComment = ""
 iRow = 1
 iColumn = -2
 iPtCount = 0
 blnColFields = True
 blnShowValues = True
 blnMakeComment = False
 '/- - - - End Variables - - - - - -

 varAnswer = _
   MsgBox("Show Selected Values for each field?" & _
   vbCr & vbCr & _
   "Select 'No' to only show Heading names", _
   vbInformation + vbYesNoCancel + vbDefaultButton2, _
   "Show Values for each field...")

 If varAnswer = vbNo Then
   blnShowValues = False
 End If

 If varAnswer = vbCancel Then
   MsgBox "This process has been canceled.", _
     vbInformation + vbOKOnly, "Warning..."
   Exit Sub
 End If

 'check for an active workbook
 'no workbooks open, so create one
 If ActiveWorkbook Is Nothing Then
     Workbooks.Add
 End If

 'Count number of worksheets in workbook
 iWorksheets = ActiveWorkbook.Sheets.Count

 'redim array
 ReDim aryHiddensheets(1 To iWorksheets)

 x = 0
 y = 0
 For Each objSheet In ActiveWorkbook.Sheets
   y = y + 1
   If objSheet.Visible <> True Then
     x = x + 1
     aryHiddensheets(x) = objSheet.name
     objSheet.Visible = True
   End If
 Next objSheet

 'Check for duplicate Worksheet name
 i = ActiveWorkbook.Sheets.Count
 For x = 1 To i
   If UCase(Worksheets(x).name) = _
     UCase(strResultsTableName) Then
     Worksheets(x).Activate
     If Err.Number = 9 Then
           Exit For
     End If
     'turn warning messages off
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.Delete
     'turn warning messages on
     Application.DisplayAlerts = True
     Exit For
   End If
 Next

 'Add new worksheet at end of workbook
 '   where results will be located
 Worksheets.Add.Move after:=Worksheets(Worksheets.Count)

'Name the new worksheet and set up Titles
 ActiveWorkbook.ActiveSheet.name = strResultsTableName
 ActiveWorkbook.ActiveSheet.Range("A1").value = _
   "Pivot Table Information"
 ActiveWorkbook.ActiveSheet.Range("A1").Font.Bold
 ActiveWorkbook.ActiveSheet.Range("A1").Font.Size = 16
 ActiveWorkbook.ActiveSheet.Range("A1").Font.Underline = _
   xlUnderlineStyleSingle

 iWorksheets = ActiveWorkbook.Sheets.Count

 Set objOutputArea = _
   ActiveWorkbook.Sheets(strResultsTableName).Range("A1")
 iRow = iRow + 1

 'Go through one Worksheet at a time
 For x = 1 To iWorksheets
   'Go to Next Worksheet
   Worksheets(x).Activate
   'Initialize formula and text/value count variables
   i = ActiveSheet.PivotTables.Count
   iPtCount = iPtCount + i
   strComment = ""
   If i > 0 And _
     UCase(ActiveSheet.name) <> _
       UCase(strResultsTableName) Then
     blnMakeComment = True
     With ActiveSheet
       For z = 1 To i
         strComment = ""
         iColumn = iColumn + 2
         ActiveWorkbook.Sheets(strResultsTableName). _
         Columns(iColumn + 1) _
           .NumberFormat = "@"

         With .PivotTables(z)
           objOutputArea.Offset(iRow, iColumn) = _
             "Pivot Table Name: " & .name
           objOutputArea.Offset(iRow, iColumn).Font.Size = 12
           objOutputArea.Offset(iRow, _
             iColumn).Font.Underline = _
             xlUnderlineStyleSingle
           objOutputArea.Offset(iRow, iColumn).Font.Bold
           iRow = iRow + 1
           strComment = strComment & "Pivot Table Name: " & _
             .name & Chr(10)

           objOutputArea.Hyperlinks.Add _
             Anchor:=objOutputArea.Offset(iRow, iColumn), _
             Address:=ActiveWorkbook.FullName, _
             TextToDisplay:="Location/Name (Workbook): " & _
             ActiveWorkbook.FullName
           iRow = iRow + 1

           objOutputArea.Hyperlinks.Add _
             Anchor:=objOutputArea.Offset(iRow, iColumn), _
             Address:=ActiveWorkbook.FullName, _
             SubAddress:= _
             Left(.SourceData, InStr(.SourceData, "!") - 1) & _
               "!" & _
             Range_RC2A1(Right(.SourceData, Len(.SourceData) - _
             InStr(.SourceData, "!"))), _
             TextToDisplay:= _
             "Data Source of Pivot Table (Worksheet): " & _
             Left(.SourceData, _
             InStr(.SourceData, "!") - 1) & "!" & _
             Range_RC2A1(Right(.SourceData, Len(.SourceData) - _
             InStr(.SourceData, "!")))
           iRow = iRow + 1
           strComment = strComment & _
             "Data Source of Pivot Table (Worksheet): " & _
             Left(.SourceData, InStr(.SourceData, _
             "!") - 1) & "!" & _
             Range_RC2A1(Right(.SourceData, Len(.SourceData) - _
             InStr(.SourceData, "!"))) & Chr(10)

           objOutputArea.Offset(iRow, iColumn) = _
             "Data Source - CacheIndex =  " & .CacheIndex
           iRow = iRow + 1
           strComment = strComment & _
             "Data Source - CacheIndex =  " & _
             .CacheIndex & Chr(10)

           objOutputArea.Hyperlinks.Add _
             Anchor:=objOutputArea.Offset(iRow, iColumn), _
             Address:=ActiveWorkbook.FullName, _
             SubAddress:=Chr(39) & ActiveSheet.name & _
             Chr(39) & "!" & _
             .TableRange2.Address, _
             TextToDisplay:= _
             "Pivot Table Location (Worksheet): " & _
             ActiveSheet.name & "!" & _
             .TableRange2.Address
           iRow = iRow + 1
           strComment = strComment & _
             "Pivot Table Location (Worksheet): " & _
             ActiveSheet.name & "!" & _
             .TableRange2.Address & Chr(10) & Chr(10) & Chr(10)

           objOutputArea.Offset(iRow, iColumn) = _
             "Row Information - Order (#)"
           objOutputArea.Offset(iRow, iColumn).Font.Bold
           iRow = iRow + 1

           objOutputArea.Offset(iRow, iColumn) = _
             "Row Heading Field(s): "
           iRow = iRow + 1
           For Each varPvtField In .RowFields
             For w = 1 To .RowFields.Count
               If varPvtField.name = .RowFields.Item(w) Then
                 objOutputArea.Offset(iRow, iColumn) = _
                   "            - " & " ( " & _
                 varPvtField.Position & " ) " & _
                 varPvtField.name
               End If
             Next w

             c = 0
             If varPvtField.name = "Data" Then
               If .ColumnFields.Count = 0 Then
                 blnColFields = False
               End If
               If .RowFields.Count = 1 Then
                 objOutputArea.Offset(iRow, iColumn) = _
                   "            - " & varPvtField.name & _
                   " *** [No Row Fields Selected]"
                Else
                 objOutputArea.Offset(iRow, iColumn) = _
                   "            - " & varPvtField.name
               End If
             End If
             iRow = iRow + 1

             For Each varPivotItem In .PivotFields( _
               varPvtField.name).PivotItems
               If varPivotItem.Visible Then
                 If blnShowValues = True Then
                   If c = 0 Then
                      objOutputArea.Offset(iRow, iColumn) = _
                        "                 Selected - " & _
                        varPivotItem.name
                     Else
                      objOutputArea.Offset(iRow, iColumn) = _
                        "                            - " & _
                        varPivotItem.name
                   End If
                   iRow = iRow + 1
                 End If
                 c = 1
               End If
             Next varPivotItem

           Next varPvtField
           If .RowGrand = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Row Grand Total is ON"
            Else
             objOutputArea.Offset(iRow, iColumn) = _
               "Row Grand Total is OFF"
           End If
           iRow = iRow + 2

           objOutputArea.Offset(iRow, iColumn) = _
             "Column Information - Order (#)"
           iRow = iRow + 1

           objOutputArea.Offset(iRow, iColumn) = _
             "Column Heading Field(s): "
           iRow = iRow + 1
           For Each varPvtField In .ColumnFields
             c = 0
             objOutputArea.Offset(iRow, iColumn) = _
               "               - " & " ( " & _
               varPvtField.Position & " ) " & _
               varPvtField.name
             iRow = iRow + 1

             For Each varPivotItem In _
               .PivotFields(varPvtField.name).PivotItems
               If varPivotItem.Visible Then
                 If blnShowValues = True Then
                   If c = 0 Then
                      objOutputArea.Offset(iRow, iColumn) = _
                        "                    Selected - " & _
                        varPivotItem.name
                     Else
                      objOutputArea.Offset(iRow, iColumn) = _
                        "                             - " & _
                        varPivotItem.name
                   End If
                   iRow = iRow + 1
                 End If
                 c = 1
               End If
             Next varPivotItem

           Next varPvtField
           If blnColFields = False Then
             iRow = iRow - 1
             objOutputArea.Offset(iRow, iColumn) = _
               "            - Data" & _
               " *** [No Column Fields Selected]"
             blnColFields = True
             iRow = iRow + 1
           End If

           If .ColumnGrand = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Column Grand Total is ON"
            Else
             objOutputArea.Offset(iRow, iColumn) = _
               "Column Grand Total is OFF"
           End If
           iRow = iRow + 2

           objOutputArea.Offset(iRow, iColumn) = _
             "Data Field(s) - "
           iRow = iRow + 1
           For Each varPvtField In .DataFields
             objOutputArea.Offset(iRow, iColumn) = _
                 "          - " & varPvtField.name
             iRow = iRow + 1
           Next varPvtField
           iRow = iRow + 1

           If .PivotFields.Count <> 0 Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Calculated Items - "
             iRow = iRow + 1

             iFieldsCount = .PivotFields.Count

             For w = 1 To iFieldsCount
               For Each objCalcItem In _
                 .PivotFields(w).CalculatedItems
                 objOutputArea.Offset(iRow, iColumn) = _
                   "           -  Calculation Name: " & _
                   objCalcItem.name
                 iRow = iRow + 1
                 objOutputArea.Offset(iRow, iColumn) = _
                   "                  - Field Name:     " & _
                   .PivotFields(w).name
                 iRow = iRow + 1
                 objOutputArea.Offset(iRow, iColumn) = _
                   "                    - Formula:     " & _
                   objCalcItem.Formula
                 iRow = iRow + 1
                 objOutputArea.Offset(iRow, iColumn) = _
                   "                     - Solve Order: " & _
                   .PivotFormulas(objCalcItem.name).Index
                 iRow = iRow + 1

               Next objCalcItem
             Next w
           End If
           iRow = iRow + 1

           If .CalculatedFields.Count <> 0 Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Calculated Fields - "
             iRow = iRow + 1

             iFieldsCount = .CalculatedFields.Count

             For Each objCalcItem In .CalculatedFields
                 objOutputArea.Offset(iRow, iColumn) = _
                   "           -  Calculation Name: " & _
                   objCalcItem.name
                 iRow = iRow + 1
                 objOutputArea.Offset(iRow, iColumn) = _
                   "                       - Formula:     " & _
                   objCalcItem.Formula
                 iRow = iRow + 1
             Next objCalcItem
           End If
           iRow = iRow + 1

           If .PageFields.Count <> 0 Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Page Name(s): "
             iRow = iRow + 1
             For Each varPvtField In .PageFields
               objOutputArea.Offset(iRow, iColumn) = _
                 "           - " & varPvtField.name
               iRow = iRow + 1

               objOutputArea.Offset(iRow, iColumn) = _
                 "                     Show - " & _
                 .PivotFields(varPvtField.name). _
                 CurrentPage
               iRow = iRow + 1
               c = 1
             Next varPvtField
             iRow = iRow + 1
           End If

           If .CubeFields.Count <> 0 Then
             If Err.Number <> 1004 Then
               For Each objCubeFld In .CubeFields
                 objOutputArea.Offset(iRow, iColumn) = _
                   "Cube Field Names - " & objCubeFld.name
                 iRow = iRow + 1
               Next objCubeFld
             End If
           End If

           If .DisplayNullString = True And _
             Len(.NullString) <> 0 Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Custom Null String: " & .NullString
             iRow = iRow + 1
           End If

           If .DisplayErrorString = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Custom Error String: " & .ErrorString
             iRow = iRow + 1
           End If

           If .EnableDrilldown = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Drilldown is enabled"
             iRow = iRow + 1
           End If

           If .ShowDetail = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Inner Detail: " & .InnerDetail
             iRow = iRow + 1
           End If

           If .ManualUpdate = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Manual Update is ON"
            Else
             objOutputArea.Offset(iRow, iColumn) = _
               "Automatic Update is ON"
           End If
           iRow = iRow + 1

           If .MergeLabels = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Merge Labels is ON"
             iRow = iRow + 1
           End If

           objOutputArea.Offset(iRow, iColumn) = _
             "Pivot Table Refresh Rate: " & _
               .PivotCache.RefreshPeriod
           iRow = iRow + 1

           objOutputArea.Offset(iRow, iColumn) = _
             "Last Refresh Date: " & .RefreshDate
           iRow = iRow + 1

           objOutputArea.Offset(iRow, iColumn) = _
             "Data last refreshed by: " & .RefreshName
           iRow = iRow + 1

           If .SaveData = True Then
             objOutputArea.Offset(iRow, iColumn) = _
               "Data for Pivot Table report is " & _
               "saved with the workbook"
            Else
             objOutputArea.Offset(iRow, iColumn) = _
               "Data for Pivot Table report is " & _
               "NOT saved with the workbook"
           End If
           iRow = iRow + 2

           objOutputArea.Offset(iRow, _
             iColumn).Interior.ColorIndex = 42

         End With
         iRow = 2
         If blnMakeComment = True Then
           Call MakeComment(strComment, _
           .PivotTables(z).TableRange2.Address)
         End If
       Next z
     End With
   End If
   blnMakeComment = False
 Next x

 Set objOutputArea = Nothing

 Cells.Select
 Selection.ColumnWidth = 2
 Cells.EntireColumn.AutoFit
 ActiveWindow.Zoom = 75

 For d = 1 To _
   ActiveSheet.Cells.SpecialCells(xlLastCell).Column
   If Columns(d).ColumnWidth > 125 Then
     With Columns(d)
       .ColumnWidth = 125
       .WrapText = True
     End With
   End If
 Next d

 Range("A1").Select

 If iPtCount = 0 Then
   'turn warning messages off
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   'turn warning messages on
   Application.DisplayAlerts = True
   MsgBox _
     "There are no Pivot Tables in the active workbook..." & _
     vbCr & _
     vbCr & Chr(34) & ActiveWorkbook.FullName & Chr(34), _
     vbCritical + vbOKOnly, "Warning..."
  Else
   'format for printing
   With ActiveSheet.PageSetup
     .PrintGridlines = True
     .PrintTitleRows = "$1:$6"
     .Orientation = xlPortrait
     .Order = xlDownThenOver
     .Zoom = False
     .FitToPagesWide = iPtCount
     .FitToPagesTall = False
     .CenterHorizontally = True
     .CenterVertically = False
   End With
 End If

 're-hide previously hidden sheets
 On Error Resume Next

 y = UBound(aryHiddensheets)
 For Each objSheet In ActiveWorkbook.Sheets
   For x = 1 To y
     If objSheet.name = aryHiddensheets(x) Then
       objSheet.Visible = False
     End If
   Next x
 Next objSheet

 If iPtCount <> 0 Then
   Application.Dialogs(xlDialogWorkbookName).Show
 End If

End Sub
'/=====================================/
Private Sub MakeComment(strDetailInfo As String, _
 strAddress As String)
 'create comment with pivot information in it [strDetailInfo]
 'strAddress is full address of Pivot Table being processed
 Dim strFirstCellInAddress As String

 'get first cell in range
 strFirstCellInAddress = GetFirstCell(strAddress)

 'if a comment exists, delete it if created by an earlier run
 ' of this macro, then create a new one
 If CommentExists(strFirstCellInAddress) = False Then
   Range(strFirstCellInAddress).AddComment
  Else
   If UCase(Left( _
     Range(strFirstCellInAddress).Comment.Text, 16)) = _
     "PIVOT TABLE NAME" Then
     Range(strFirstCellInAddress).Comment.Delete
     Range(strFirstCellInAddress).AddComment
   End If
 End If

 With Range(strFirstCellInAddress).Comment
   .Visible = False

   If Len(.Text) > 0 Then
     .Text Text:=.Text & Chr(10) & strDetailInfo
    Else
     .Text Text:=strDetailInfo
   End If

   .Shape.ScaleHeight 1.75, msoFalse, msoScaleFromTopLeft
   .Shape.ScaleWidth 2, msoFalse, msoScaleFromTopLeft

'    .Visible = True
 End With

End Sub
'/=============================================/
Private Function CommentExists(strRng As String) As Boolean
 'test if there is a comment in the current range [strRng]
 'return False if no Comment / True if cell has comment
 Dim rng As Range
 On Error GoTo err_Function

 CommentExists = True

 Set rng = Range(strRng)

 If rng.Comment Is Nothing Then
   CommentExists = False
 End If

'  Set cmtComment = rng.Comment
'  If cmtComment Is Nothing Then
'    CommentExists = False
'  End If

exit_Function:
 Set rng = Nothing
 Exit Function

err_Function:
 CommentExists = False
 GoTo exit_Function

End Function
'/=============================================/
Private Function GetFirstCell(strFullRng As String) As String
 'get 1st cell in a range / Return offset of 2 columns
 'for example:  in $A$5:$D$9, $C$5 is returned
 Dim rng As Range
 Dim strFirstCell As String
 On Error GoTo err_Function

 strFirstCell = _
   Left(strFullRng, _
   Application.WorksheetFunction.Find(":", strFullRng) - 1)

 Set rng = Range(strFirstCell).Offset(0, 2)

 GetFirstCell = rng.Address

exit_Function:
 Set rng = Nothing
 Exit Function

err_Function:
 GetFirstCell = "C1"
 GoTo exit_Function

End Function
'/=============================================/