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.Underl ine = _
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
'/=============================================/


--
HTH,
Gary Brown

If this post was helpful to you, please select ''YES'' at the bottom of the
post.



"Jayashree Krishna" wrote:

Hi,

I want to see the souce field for each of page field,row field,column field
and data field of pivot table. if I right click on the pivot table and
select the field settings property , I could get the "source field" on the
top only for data fields . I couldn't see the source for page fields. Is
there any way to see the source for page fields?
Thanks,
Krishna