'Решение 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