Замена меток «Page Title» в «дереве» выдачи на содержимое заголовков от команды «TITLE»

 

Загрузить как .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
'Begin Description
'Скрипт заменяет подпись "Page Title" (заголовок страницы) в колонке "дерева" результатов (слева в окне выдачи)
'на содержимое этого заголовка из раздела самих результатов (справа в окне выдачи).
'Это удобно для быстрой навигации по файлу выдачи: можно ориентироваться на заголовки,
'которые сам пользователь определил через синтаксис.
'Условия: документ выдачи (Output) должен быть открыт.
'Ограничения: перед запуском скрипта вам нужно, чтобы был выполнен синтаксис,
'содержащий в себе несколько команд TITLE (определение заголовка страницы).
' Например:
' TITLE="*** Начинаем чистку данных".
' (какой-то синтаксис)
' TITLE="*** Слияние с основным файлом данных".
'End Description

'Автор: Raynald Levesque, 01.09.2002.
'http://www.spsstools.ru

'Перевод: А. Балабанов, 19.11.2008.
'Проверено: SPSS 15.0.0. При работе с кириллическими шрифтами в заголовках (как в примере выше) скрипт работает
' некорректно: при замене "Page Title" на заголовок вместо кириллических символов появляются пробелы. Требует коррекции. Примеч. перев.

Option Explicit

Sub main
	Call ChangePageTitles
End Sub


Sub ChangePageTitles()
' Подпись "Page Title" в дереве навигации заменяется содержимым заголовка страницы из правой части окна выдачи
' Процедура применяется к текущему окну результатов (окну назначения, 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

'Получение ссылок на текущий документ выдачи и коллекцию объектов в нём
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 = strTitle 'UCase(strTitle)
	End If
Next
Exit Sub

Oopps:
	MsgBox Err.Number & " " & Err.Description	   'в случае ошибки: информация пользователю
	Debug.Print Err.Number & " " & Err.Description 'информация для отладки
End Sub
Related pages

...

Navigate from here