Запись оглавления окна результатов в текстовый файл

 

Загрузить как .sbs Показать простым текстом

 

 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
'Сохранение оглавления (Table Of Content = TOC) текущего окна результатов в текстовый файл.
'Данная версия создаёт оглавление в файле c:\\temp\\TOC.txt. Поменяйте имя и путь по своим надобностям.

'Скрипт добавляет последовательную нумерацию к заголовкам большинства объектов в окне результатов
'(исключения составляют объекты GRAPH; их непросто изменить скриптом, а использование инструкции
'SendKeys будет проблематично).
'Те же номера и заголовки появляются в импровизированном оглавлении, которое записывается в текстовый файл.
'Нумеруются и включаются в оглавление только видимые объекты окна результатов.

'Автор: rlevesque@videotron.ca, 19.05.2001
'http://www.spsstools.net

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
    'Нам нужно работать лишь если имеется, по крайней мере, одно открытое окно результатов.
    If objSpssApp.Documents.OutputDocCount > 0 Then
       'Привязываемся к текущему окну результатов.
       Set objOutDoc = objSpssApp.GetDesignatedOutputDoc
       Set objItems = objOutDoc.Items
    Else
       MsgBox "Нет открытого окна результатов!"
       Exit Sub
    End If
	Open "c:\\temp\\TOC.txt" For Output As #1
	Print #1, "Оглавление составлено " & 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
					' ничего не делаем
	        
	            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
	            	' Изменяем метку в дереве результатов
	            	.Label = "# " & ItemIndex & " " & .Label
		            Print #1, Space$(.Level * 3) & .Label
	            	' Изменяем текст в заголовке таблицы
			        Set objPivotTable=.ActivateTable
	                strLabel=objPivotTable.TitleText
	                objPivotTable.TitleText= "# " & ItemIndex & " " & objPivotTable.TitleText
					.Deactivate

	            Case SPSSTitle, SPSSLog, SPSSText
	            	' Изменяем метку в дереве результатов
	            	.Label = "# " & ItemIndex & " " & .Label
	            	Print #1, Space$(.Level * 3) & .Label
	            	' Изменяем текст в окне выдачи
	            	Set objSpssText = .ActivateText
	            	objSpssText.Text = "# " & ItemIndex & " " & objSpssText.Text
	            	.Deactivate

	            Case SPSSChart
        			' Метка в дереве результатов
	            	.Label = "# " & ItemIndex & " " & .Label
            		Print #1, Space$(.Level * 3) & .Label

	            Case SPSSIGraph
   	            	' Метка в дереве результатов
	            	.Label = "# " & ItemIndex & " " & .Label
	            	Print #1, Space$(.Level * 3) & .Label
	            	' Текст в заголовке (IGraphTitle) в окне результатов
					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)	'Пропускаем одну строку между объектами
	        End If
        End With
    Next ItemIndex

End Sub
Related pages

...

Navigate from here