Построение оглавления таблиц и замена табличных заголовков по оглавлению

'Решение SPSS AnswerNet №100007868

'Заголовок: Создание таблицы содержания для мобильных таблиц и обновление заголовков мобильных таблиц

'Вопрос.
'Я хотел бы создать во внешнем файле что-то вроде оглавления (с заголовками мобильных таблиц из файла выдачи).
'Кроме того, далее я хотел бы заменить заголовки в выдаче у некоторых мобильных таблиц.
'Могут ли мне в этом как-то помочь скрипты?

'Ответ.
'Ниже приводится код для двух скриптов, которые могут помочь. Первый из них должен быть сохранён в файле GetTitleList.sbs.
' Запустите его для того, чтобы получить текстовый файл, содержащий заголовки всех мобильных таблиц из текущего окна результатов.

'Если необходимо, отредактируйте полученный файл, а затем запустите скрипт SetTitleList.sbs.
'Тогда изменённые заголовки, найденные в файле, заменят исходные заголовки мобильных таблиц в окне результатов.

'Для работы скопируйте выделенные ниже части кода в отдельные пустые окна редактора
'скриптов и сохраните в отдельных файлах.

'Перевод: А. Балабанов, 19.11.2008.
'Проверено: SPSS 15.0.0, Win XP SP3.

'****************************** СОХРАНИТЕ СЛЕДУЮЩИЙ КОД КАК 'GetTitleList.sbs' ******************************
'Begin Description
'Сохраняет перечень заголовков мобильных таблиц в текстовый файл, который может быть
'отредактирован для последующего использования скриптом SetTitleList.SBS (переназначения заголовков),
'либо для оформления содержания / указателя таблиц.
'End Description
Sub Main
'Назначение: Вывести перечень заголовков мобильных таблиц в файл, который может быть отредактирован для использования со скриптом SetTitleList
'Условия: имеется открытый документ выдачи (Output Doc, Navigator)
'Эффект: записанный текстовый файл с заголовками таблиц
'Входные данные: имя файла для записи заголовков
'Возвращаемые значения: нет
ListPivotTableTitles GetFilePath ("перечень_заголовков", "txt", , "Сохранение перечня заголовков", 3)
End Sub

Sub ListPivotTableTitles(strTitleList As String)
Dim objDocuments As ISpssDocuments ' Коллекция документов SPSS.
Dim objOutputDoc As ISpssOutputDoc ' Документ SPSS Output
Dim objItems As ISpssItems ' Коллекция объектов Output Navigator'а
Dim objItem As ISpssItem ' отдельный объект
Dim objPivot As PivotTable ' Мобильная таблица
Dim i As Integer

'выход из процедуры, если пользователь нажал "Отмена" (не указал имя файла)
If strTitleList = "" Then Exit Sub

'Ссылка на коллекцию документов SPSS.
Set objDocuments = objSpssApp.Documents

' Устанавливаем ссылку на текущее окно выдачи только если имеется хотя бы одно окно выдачи.
' Пропуск этой проверки может приводить к ошибкам.
If objDocuments.OutputDocCount > 0 Then
'Получение ссылки на текущий документ выдачи.
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Else
'Если документов выдачи не обнаружено, выходим из скрипта.
'Следующую строку можно закомментировать, тогда выход пройдёт без дополнительного сообщения пользователю.
MsgBox "Пожалуйста, откройте окно результатов перед запуском скрипта.", vbExclamation, "Ошибка выполнения скрипта"
Exit Sub
End If

' Получение перечня объектов выдачи (Navigator'а).
Set objItems = objOutputDoc.Items

On Error GoTo CloseFile

'Откроем файл на запись
Open strTitleList For Output As #1

' Обрабатываем каждый объект из Навигатора (цикл по всей выдаче).
For i = 0 To objItems.Count - 1
Set objItem = objItems.GetItem(i) 'Ссылка на очередной объект.
'Проверяем, является ли объект мобильной таблицей
If objItem.SPSSType = SPSSPivot Then
'*************************************************************
'Здесь, наконец, мы записываем в файл заголовок очередной таблицы:
Print #1, objItem.Label
'*************************************************************
End If
Next

CloseFile:
Close #1
End Sub


'****************************** СОХРАНИТЕ ПРЕДШЕСТВУЮЩИЙ КОД КАК 'GetTitleList.sbs' ******************************

'****************************** СОХРАНИТЕ СЛЕДУЮЩИЙ КОД КАК 'SetTitleList.sbs' ******************************
'Begin Description
'Заменяет заголовки мобильных таблиц в соответствии с перечнем, содержащемся во внешнем текстовом файле
' (созданном, например, скриптом 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.
Dim objOutputDoc As ISpssOutputDoc ' Документ SPSS Output
Dim objItems As ISpssItems ' Коллекция объектов выдачи (Output Navigator'a)
Dim objItem As ISpssItem ' отдельный объект выдачи
Dim objPivot As PivotTable ' мобильная таблица
Dim i As Integer

Dim strTitle As String

'выходим из скрипта, если пользователь нажал "Отмена" (имя файла не получено)
If strTitleList = "" Then Exit Sub

'Получение ссылки на коллекцию документов SPSS.
Set objDocuments = objSpssApp.Documents

' Устанавливаем ссылку на текущий документ выдачи, только если в системе открыт хотя бы один такой документ.
' Пропуск этой проверки может приводить к ошибкам выполнения скрипта.
If objDocuments.OutputDocCount > 0 Then
	'Установим ссылку на текущее окно выдачи
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Else
	'Если нет открытых окон выдачи, завершаем работу скрипта.
	'Чтобы пользователь не получал об этом дополнительных предупреждений, можно закомментировать следующую строку кода:
	MsgBox "Пожалуйста, откройте окно результатов перед запуском скрипта.", vbExclamation, "Ошибка выполнения скрипта"
	Exit Sub
End If

' Получения дерева объектов Навигатора результатов.
Set objItems = objOutputDoc.Items

On Error GoTo CloseFile

'откроем файл для чтения
Open strTitleList For Input As #1

' Проходим циклом по всем объектам выдачи (Navigator'а).
For i = 0 To objItems.Count - 1
	Set objItem = objItems.GetItem(i) 'Ссылка на очередной объект.
	'Проверка, является ли объект мобильной таблицей
	If objItem.SPSSType = SPSSPivot Then
		Set objPivot = objItem.ActivateTable() 'Активируем мобильную таблицу.
		objPivot.UpdateScreen = False 'Откладываем перерисовку (обновление экрана) на потом.

		'*************************************************************
		'Здесь, наконец, читаем из файла очередной заголовок и вставляем его в таблицу:
		Line Input #1, strTitle
		objPivot.TitleText = strTitle
		'*************************************************************

		'теперь выполняем перерисовку
		objPivot.UpdateScreen = True

		objItem.Label = strTitle
		'Завершение обработки объекта: всегда выходим из режима редактирования объекта.
		'Помним, что активации подвергался объект как таковой (Item), а не мобильная таблица как таковая.
		objItem.Deactivate
	End If
Next

CloseFile:
Close #1
End Sub

'****************************** СОХРАНИТЕ ПРЕДШЕСТВУЮЩИЙ КОД КАК 'SetTitleList.sbs' ******************************

'Создано: 22.10.2000