Produce a Table of Content (TOC) listing all pivot tables

'SPSS AnswerNet Solution ID: 100007868

'Title: Table of Contents For PivotTables/Re-labeling PivotTables

'Q.
'I would like to produce a Table of Contents listing all the Pivot Tables in my Output file.
'Moreover, I would like to change the titles of some of the tables. Is there any way that
' Scripting can assist?

'A.
'Below are two scripts which may help. The first should be saved as GetTitleList.sbs.
' Run it to produce a file containing the titles of All the tables in the designated Output window.

'If desired, edit the file, then run SetTitleList.sbs. The titles found in the file will
'replace the originals in the Output.

'Copy the indicated portions, paste each into a completely empty script window, and save.

'****************************** SAVE FOLLOWING AS 'GetTitleList.sbs' ******************************

'Begin Description
'List all PivotTable titles in a file, which can be edited for use by
'SetTitleList.SBS,
'or to construct a Table of Contents.
'End Description
Sub Main
'Purpose: List all PivotTable titles in a file, which can be edited and used by SetTitleList
'Assumptions: there is an open Output Doc (Navigator)
'Effects: writes text file listing titles
'Inputs: name of file to save
'Return Values: none

ListPivotTableTitles GetFilePath ("Title List", "txt", , "Save Title List", 3)
End Sub

Sub ListPivotTableTitles(strTitleList As String)
Dim objDocuments As ISpssDocuments ' SPSS documents.
Dim objOutputDoc As ISpssOutputDoc ' Output document
Dim objItems As ISpssItems ' Output Navigator items
Dim objItem As ISpssItem ' individual item
Dim objPivot As PivotTable ' The Pivot Table
Dim i As Integer

'nothing to do if user pressed cancel, i.e. there was no file supplied
If strTitleList = "" Then Exit Sub

'Get list of documents in SPSS.
Set objDocuments = objSpssApp.Documents

' Get designated document only if there is at least one output document.
' Omitting this test results in a error message.
If objDocuments.OutputDocCount > 0 Then
'Get the currently designated output document.
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Else
'If no navigator window exists, quit the script.
'comment the following line out and the script will go away silently.
MsgBox "Please open an output window before running this script.", _
vbExclamation, "Script Error"
Exit Sub
End If

' Get the outline tree from the Navigator.
Set objItems = objOutputDoc.Items

On Error GoTo CloseFile

'open the output file
Open strTitleList For Output As #1

' Get each item in the Navigator.
For i = 0 To objItems.Count - 1
Set objItem = objItems.GetItem(i) 'Get each item in turn.
'Check to see if it's a PivotTable
If objItem.SPSSType = SPSSPivot Then
'*************************************************************
'Here's where we do the work:
Print #1, objItem.Label
'*************************************************************
End If
Next

CloseFile:
Close #1
End Sub

'****************************** SAVE PRECEDING AS 'GetTitleList.sbs' ******************************

'****************************** SAVE FOLLOWING AS 'SetTitleList.sbs' ******************************
'Begin Description
'Changes the titles of all PivotTable titles to match values in a file,
'such as produced by SetTitleList.SBS.
'End Description
Sub Main
SetPivotTableTitles GetFilePath$ ("Title List", "txt", , "Apply Title List", 0)
End Sub

Sub SetPivotTableTitles(strTitleList As String)
Dim objDocuments As ISpssDocuments ' SPSS documents.
Dim objOutputDoc As ISpssOutputDoc ' Output document
Dim objItems As ISpssItems ' Output Navigator items
Dim objItem As ISpssItem ' individual item
Dim objPivot As PivotTable ' The Pivot Table
Dim i As Integer

Dim strTitle As String

'nothing to do if user pressed cancel, i.e. there was no file supplied
If strTitleList = "" Then Exit Sub

'Get list of documents in SPSS.
Set objDocuments = objSpssApp.Documents

' Get designated document only if there is at least one output document.
' Omitting this test results in a error message.
If objDocuments.OutputDocCount > 0 Then
	'Get the currently designated output document.
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Else
	'If no navigator window exists, quit the script.
	'comment the following line out and the script will go away silently.
	MsgBox "Please open an output window before running this script.", _
		vbExclamation, "Script Error"
	Exit Sub
End If

' Get the outline tree from the Navigator.
Set objItems = objOutputDoc.Items

On Error GoTo CloseFile

'open the output file
Open strTitleList For Input As #1

' Get each item in the Navigator.
For i = 0 To objItems.Count - 1
	Set objItem = objItems.GetItem(i) 'Get each item in turn.
	'Check to see if it's a PivotTable
	If objItem.SPSSType = SPSSPivot Then
		Set objPivot = objItem.ActivateTable() 'Activate the pivot table.
		objPivot.UpdateScreen = False 'Defer drawing until later.

		'*************************************************************
		'Here's where we do the work:
		'read the value from the file
		Line Input #1, strTitle

		'change the title
		objPivot.TitleText = strTitle
		'*************************************************************

		'do all the drawing at once
		objPivot.UpdateScreen = True

		objItem.Label = strTitle
		'Clean-up time: Always remember to Deactivate when finished.
		'note that it's the Item, not the Pivot Table, which is deactivated,
		'just as it was the Item that was Activated.
		objItem.Deactivate
	End If
Next

CloseFile:
Close #1
End Sub

'****************************** SAVE PRECEDING AS 'SetTitleList.sbs' ******************************

'Created On: 10/22/2000