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
'Begin Description
'This replaces "Page Title" in the Output left pane by the content of the "Page Title" in the
'right pane. This is useful to place quick reference in the left pane to locate given areas
'of the output
'Requirement: the Output Document must be open.
'Restriction: Before running this, you must have run a syntax file with a few TITLE commands
' For instance.
' TITLE="*** Starting cleaning of data".
' (syntax)
' TITLE="*** Merging data with master file".
'End Description

'Author: Raynald Levesque 2002/09/01
'http://pages.infinit.net/rlevesqu/index.htm

Option Explicit

Sub main
	Call ChangePageTitles
End Sub


Sub ChangePageTitles()
' PageTitle in left pane is replaced by content of right pane
' Acts on designated output window

Dim objOutputDoc As ISpssOutputDoc
Dim objOutputItems As ISpssItems
Dim objOutputItem As ISpssItem

Dim strTitle As String
Dim cnt As Integer

On Error GoTo Oopps

'Get designated output document and items collection
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Set objOutputItems = objOutputDoc.Items

For cnt = 0 To objOutputItems.Count - 1
	Set objOutputItem = objOutputItems.GetItem(cnt)
	If objOutputItem.SPSSType = SPSSPageTitle Then
		strTitle = objOutputItem.ActivateText.Text
		objOutputItem.Deactivate
		objOutputItem.Label = UCase(strTitle)
	End If
Next
Exit Sub

Oopps:
	MsgBox Err.Number & " " & Err.Description	   'inform user
	Debug.Print Err.Number & " " & Err.Description 'for future reference
End Sub