Option Explicit ' Определим 3 константы для 3 режимов выравнивания Const SpssHAlLeft=0 'Горизонтальная выключка влево Const SpssHAlRight=1 'Горизонтальная выключка вправо Const SpssHAlCenter=2 'Горизонтальная выключка по центру Sub Main 'Выравнивание заголовков во всех мобильных таблицах в назначенном окне результатов 'Автор: rlevesque@videotron.ca, 24.01.2002 'http://www.spsstools.ru ' Перевод: А. Балабанов, 11.01.2009. ' Проверено: SPSS 15.0.0. ' Размещение: http://www.spsstools.ru/Scripts/PivotTables/LeftRightOrCenterJustifyTitleOfAllPivotTables.txt (.sbs). Dim objPivot As PivotTable Dim objItem As ISpssItem Do While GetNextPivot(objPivot, objItem) objPivot.SelectTitle ' при необходимости используйте другую константу, определяющую выравнивание objPivot.HAlign=SpssHAlLeft objItem.Deactivate Loop End Sub Function GetNextPivot(objPivot As PivotTable, objItem As ISpssItem) As Boolean 'Назначение: Переход к обработке следующей мобильной таблицы 'Условия: в окне результатов (Output Navigator) находятся мобильные таблицы; выдача не меняется между вызовами процедуры 'Действия: каждый вызов процедуры, активирует следующую мобильную таблицу 'Входящие параметры: ссылка на мобильную таблицу и объект, содержащий выделенную мобильную таблицу 'Исходящие параметры: активированная таблица, ссылка на объект, содержащий таблицу; значение функции "Истина", если была найдена и активирована следующая мобильная таблица Static objDocuments As ISpssDocuments ' коллекция документов SPSS Static objOutputDoc As ISpssOutputDoc ' документ выдачи (результатов, Output) Static objItems As ISpssItems ' коллекция объектов в окне выдачи Static intItem As Integer ' индекс очередного объекта Static intItemCount As Integer ' общее число объектов в окне выдачи Dim intItemType As Integer '### Dim bolSelected As Boolean ' "Истина", если объект выделен - удалено - А.Б. Dim bolReset As Boolean Dim i As Integer ' инициализация возвращаемых значений GetNextPivot = False Set objPivot = Nothing Set objItem = Nothing ' если функция за время исполнения скрипта вызвана первый раз, установим флаг, указывающий на необходимость инициализации некоторых переменных If (objDocuments Is Nothing) Or (objOutputDoc Is Nothing) Or (objItems Is Nothing) Then bolReset = True End If If bolReset Then 'Установление ссылки на коллекцию документов SPSS. Set objDocuments = objSpssApp.Documents End If ' закончена обработка переменной с коллекцией документов If bolReset Then ' Установление ссылки на текущий документ выдачи только если есть хотя бы один такой документ. If objDocuments.OutputDocCount > 0 Then 'Ссылка на текущий документ выдачи (окно результатов) Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc Else 'Если отсутствуют окна результатов MsgBox( "Не найдено окна с результатами (Output Navigator)!" ) Exit Function End If End If ' закончена обработка переменной с документом Output ' Установление ссылки на дерево объектов и подсчёт количества объектов в окне результатов: If bolReset Then Set objItems = objOutputDoc.Items intItemCount = objItems.Count End If ' Убедимся, что не было никаких сбоев при инициализации переменных. В случае проблем - сообщение пользователю и выход If (objDocuments Is Nothing) Or (objOutputDoc Is Nothing) Or (objItems Is Nothing) Then Debug.Print "Пустая ссылка objDocuments: " & (objDocuments Is Nothing) Debug.Print "Пустая ссылка objOutputDoc: " & (objOutputDoc Is Nothing) Debug.Print "Пустая ссылка objItems: " & (objItems Is Nothing) MsgBox "Случились проблемы при инициализации переменных окна навигатора результатов!", vbExclamation, "GetNextPivot" Exit Function End If ' Проверка, что документ Output не изменился между вызовами функции. Если изменился: сообщение и выход If intItemCount <> objItems.Count Then MsgBox "Содержимое окна результатов изменилось во время выполнения скрипта!", vbExclamation, "GetNextPivot" Exit Function End If If bolReset Then intItem = 0 End If ' Активация следующей мобильной таблицы For i = intItem To intItemCount - 1 Set objItem = objItems.GetItem(i) intItemType = objItem.SPSSType If intItemType = SPSSPivot Then intItem = i + 1 ' при следующем вызове начнём отсюда Set objPivot = objItem.ActivateTable() ' активация мобильной таблицы GetNextPivot = True ' Подтверждение, что мобильная таблица обнаружена и активирована Exit For ' Выход из цикла End If Next i If GetNextPivot = False And intItem = 0 Then 'Не было найдено мобильной таблицы MsgBox( "Мобильных таблиц не обнаружено!" ) Exit Function End If End Function