1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
'To save the Table Of Content (TOC) of the currently Designated Output in a text file.
'Presently c:\\temp\\TOC.txt is created, change name and path to suit your need.

'The script adds a sequential number to the Title of most objects in the Output  
'window (the only exception GRAPH; they cannot easyly be changed by script and
'SendKeys Is a bit problematic).
'The same number appears in the TOC and in the printout of the Output window. 
'Only visible items of the Output are included in the TOC.

'rlevesque@videotron.ca 2001/05/19
'http://pages.infinit.net/rlevesqu/

Option Explicit

Sub Main
Dim objOutDoc As ISpssOutputDoc, objItems As ISpssItems, objPivotTable As PivotTable
Dim objIGraph As ISpssIGraph, objSpssText As ISpssrtf
Dim strLabel As String, ItemIndex As Long, intTab As Integer
    'Continue the program only if there is at least one output document.
    If objSpssApp.Documents.OutputDocCount > 0 Then
       'Get the currently designated output document items collection.
       Set objOutDoc = objSpssApp.GetDesignatedOutputDoc
       Set objItems = objOutDoc.Items
    Else
       MsgBox "No Navigator window exists!"
       Exit Sub
    End If
	Open "c:\\temp\\TOC.txt" For Output As #1
	Print #1, "TOC produced " & Now
    For ItemIndex=0 To objItems.Count-1
        With objItems.GetItem(ItemIndex)
			If .Visible Then
'				Debug.Print .SPSSType
	       		Select Case .SPSSType
				Case SPSSUnknown, SPSSRoot, SPSSPageTitle, SPSSWarning
					' nothing to do
	        
	            Case SPSSNote
	            	.Label = "# " & ItemIndex & " " & .Label
	            	strLabel = .Label
			        Set objPivotTable=.ActivateTable
	                objPivotTable.TitleText= "# " & ItemIndex & " " & objPivotTable.TitleText
	                strLabel=objPivotTable.TitleText
					Print #1, Space$(.Level * 3) & strLabel
					.Deactivate

	            Case SPSSPivot
	            	' Change Label in Outline window
	            	.Label = "# " & ItemIndex & " " & .Label
		            Print #1, Space$(.Level * 3) & .Label
	            	' Change Text in Title of Pivot Table
			        Set objPivotTable=.ActivateTable
	                strLabel=objPivotTable.TitleText
	                objPivotTable.TitleText= "# " & ItemIndex & " " & objPivotTable.TitleText
					.Deactivate

	            Case SPSSTitle, SPSSLog, SPSSText
	            	' Change Label in Outline window
	            	.Label = "# " & ItemIndex & " " & .Label
	            	Print #1, Space$(.Level * 3) & .Label
	            	' Change Text in Output window
	            	Set objSpssText = .ActivateText
	            	objSpssText.Text = "# " & ItemIndex & " " & objSpssText.Text
	            	.Deactivate

	            Case SPSSChart
        			' Label in Outline window
	            	.Label = "# " & ItemIndex & " " & .Label
            		Print #1, Space$(.Level * 3) & .Label

	            Case SPSSIGraph
   	            	' Label in Outline window
	            	.Label = "# " & ItemIndex & " " & .Label
	            	Print #1, Space$(.Level * 3) & .Label
	            	' Text in IGraphTitle of Output window
					Set objIgraph = .Activate
					objIGraph.Title = "# " & ItemIndex & " " & objIGraph.Title
					objIGraph.Redraw
					.Deactivate

				Case Else
					.Label = "# " & ItemIndex & " " & .Label
	            	Print #1, Space$(.Level * 3) & .Label
	            End Select
              	Print #1, Space$(1)	'Skip one line between objects
	        End If
        End With
    Next ItemIndex

End Sub