'Begin Description 'Во всех таблицах из назначенного окна результатов скрипт изменяет форматирование меток строки/столбца и соответствующих ячеек данных, 'в случае, если метка содержит слово "Total". В данной редакции информация выделяется синим и полужирным. 'Условия: в назначенном окне результатов присутствует, по крайней мере, одна мобильная таблица. 'End Description 'MakeTotalsBoldAllPivotTables.SBS 'Это - модификация скрипта MakeTotalsBold.SBS 'Автор изменений: Raynald Levesque, 14.11.2004. 'Характер изменений: обрабатываются все видимые мобильные таблицы, а не только одна выделенная. 'ЭТОТ СКРИПТ СОЗДАН НА ОСНОВЕ ШАБЛОННОГО (STARTER) СКРИПТА 'Reformat by Labels'(REFORMLB.sbs) 'НАЗНАЧЕНИЕ 'В выделенной таблице скрипт изменяет форматирование меток строки/столбца и соответствующих ячеек данных, 'в случае, если метка содержит слово "Total". 'УСЛОВИЯ 'Мобильная таблица, в которой присутствуют метки строк/столбцов/слоёв, содержащих слово "Total", выделена в назначенном окне результатов. 'ДЕЙСТВИЯ 'Изменяет форматирование текста меток и соответствующих ячеек данных на синий с полужирным начертанием 'СОВЕТЫ 'Если вы новичок в программировании, ознакомьтесь с разделом Scripting Tips меню 'справки (Help) редактора скриптов SPSS для получения начальных сведений. 'Для получения информации об объектах автоматизации SPSS, их методах и свойствах, 'нажмите в редакторе скриптов клавишу F2 - отобразится Object Browser - навигатор по объектам. 'Для получения контекстной справки по терминам языка Sax Basic и объектам SPSS, их свойствам ' и методам, нажмите F1. 'Перевод: А. Балабанов, 11.01.2009. 'Проверено: SPSS 15.0.0. 'Размещение: http://www.spsstools.ru/Scripts/PivotTables/MakeTotalsBold.sbs (.txt). Option Explicit 'Указание на то, что все переменные должны быть явно объявлены перед использованием 'строковые константы (искомая метка) Const cTOTAL As String = "Total" 'константы, определяющие элементы, подвергаемые переформатированию Public Const LABELS_ONLY As Integer = 0 'только метки Public Const DATA_ONLY As Integer = 1 'только элементы данных Public Const LABELS_AND_DATA As Integer = 2 'метки и элементы данных 'константы, определяющие тип поиска в метках строк/столбцов (точное/частичное совпадение) Public Const EXACT_MATCH As Integer = 0 'точное Public Const PARTIAL_MATCH As Integer = 1 'частичное Public bolCellsSelected As Boolean Sub Main() Dim objPivot As PivotTable Dim objItem As ISpssItem Do While GetNextPivot(objPivot, objItem) If objItem.Visible = vbTrue Then 'форматируем только видимые мобильные таблицы Call MakeTotalsBold(objPivot, objItem) End If objItem.Deactivate Loop End Sub Sub MakeTotalsBold(objPivotTable As PivotTable, objItem As ISpssItem) ' Объявление переменных, используемых для разных специальных нужд Dim strTargetText As String ' Текст для поиска нужных меток Dim intTargetType As Integer ' Тип ячеек (метка столбца, строки, данные) Dim intTargetFormat As Integer ' Тип применяемого форматирования Dim bolFoundOutputDoc As Boolean Dim bolPivotSelected As Boolean Dim intSearchType As Integer bolCellsSelected = False ' Укажите, что следует отформатировать: ' ********************************************************** ' Замените "Total" (в константе cTOTAL выше) на нужную метку строки/столбца/слоя. ' Следует точно указать искомую метку, как она есть в таблице, сохраняя все знаки, включая пробелы. ' Кавычки не убирайте. ' ********************************************************** strTargetText = cTOTAL 'Если требуется точное совпадение искомой метки со строкой strTargetText, уберите символ ' из следующей строки 'intSearchType = EXACT_MATCH 'Если требуется хотя бы частичное совпадение искомой метки со строкой strTargetText, уберите символ ' из следующей строки intSearchType = PARTIAL_MATCH '************************************************************************* 'Следующий раздел выделяет ячейки, подлежащие переформатированию. 'Вы можете указать элементы таблицы, подлежащие форматированию, изменив второй аргумент 'в вызове процедур SelectRowLabelsByText и SelectColLabelsByText. 'Если необходимо переформатировать только метки, измените второй аргумент на LABELS_ONLY 'Если необходимо переформатировать только ячейки данных, измените второй аргумент на DATA_ONLY 'Если надо переформатировать и метки, и данные, измените второй аргумент на LABELS_AND_DATA 'Если требуется вести поиск в метках строк, уберите символ ' в начале следующей строки Call SelectRowLabelsByText(strTargetText, LABELS_AND_DATA, intSearchType, objPivotTable) 'Если требуется вести поиск в метках столбцов, уберите символ ' в начале следующей строки Call SelectColLabelsByText(strTargetText, LABELS_AND_DATA, intSearchType, objPivotTable) '************************************************************************* If bolCellsSelected = True Then 'следующий раздел форматирует выделенные метки и/или данные With objPivotTable 'Уберите ' в следующей строке, если надо спрятать выделенные ячейки '.TextHidden = True 'Следующие 4 строки отвечают за начертание шрифта. 'Уберите ' в строке, соответствующей желаемому стилю шрифта. '.TextStyle = 0 'обычный '.TextStyle = 1 'курсив .TextStyle = 2 'полужирный '.TextStyle = 3 'полужирный курсив 'Уберите ' из следующей строки, если требуется ввести подчёркивание '.TextUnderlined = true 'Следующие 6 строк отвечают за цвет шрифта. 'Уберите ' из строки, которая соответствует желаемому цвету '.TextColor = RGB(255, 0, 0) 'Красный .TextColor = RGB(0, 0, 255) 'Синий '.TextColor = RGB(0, 255, 0) 'Зеленый '.TextColor = RGB(255, 255, 0) 'Желтый '.TextColor = RGB(0, 0, 0) 'Черный '.TextColor = RGB(255, 255, 255)'Белый 'Следующие 6 строк определяют фон выделенных ячеек. 'Уберите ' из строки, соответствующей желаемому фону '.BackgroundColor = RGB(255, 0, 0) 'Красный '.BackgroundColor = RGB(0, 0, 255) 'Синий '.BackgroundColor = RGB(0, 255, 0) 'Зеленый '.BackgroundColor = RGB(255, 255, 0) 'Желтый '.BackgroundColor = RGB(0, 0, 0) 'Черный '.BackgroundColor = RGB(255, 255, 255) 'Белый 'Следующая строка определяет размер шрифта в выделенных ячейках. 'Уберите ' для управления размером. Укажите нужный размер после знака = '.TextSize = 10 'задайте нужный размер в пунктах 'Следующие 4 строки управляют размерами отступов от текста в выделенных ячейках. 'Уберите ' для изменения отступов. Введите нужное значение после знака = '.TopMargin = 2 'Укажите верхний отступ в пунктах '.BottomMargin = 2 'Укажите нижний отступ в пунктах '.LeftMargin = 2 'Укажите левый отступ в пунктах '.RightMargin = 2 'Укажите правый отступ в пунктах 'Следующие 2 строки управляют выравниванием текста в выделенных ячейках. 'Уберите ' для изменения выравнивания. Укажите нужное значение после знака = '.HAlign = 2 '0=влево, 1=вправо, 2=по центру '.VAlign = 2 '0=вверх, 1=вниз, 2=по центру End With End If ' Деактивация мобильной таблицы и выход objItem.Deactivate End Sub Sub SelectRowLabelsByText (strText As String, intType As Integer, intCriteria As Integer, objPivotTable As PivotTable) Dim objRowLabels As ISpssLabels ' массив меток строк Dim intCol As Integer ' число столбцов в массиве меток Dim intRow As Integer ' число строк в массиве меток Dim intR As Integer ' счетчик цикла Dim intC As Integer ' счетчик цикла 'Выделение меток строк с ячейками данных или без (как указано) ' ссылка на массив меток строк Set objRowLabels = objPivotTable.RowLabelArray ' RowLabelArray - двумерный массив. Цикл по всем элементам массива в поисках метки, ' совпадающей с искомым текстом (strText) intCol = objRowLabels.NumColumns intRow = objRowLabels.NumRows For intC = 0 To intCol - 1 For intR = 0 To intRow - 1 If (objRowLabels.ValueAt(intR,intC) = strText And intCriteria = EXACT_MATCH) _ Or (InStr(objRowLabels.ValueAt(intR,intC), strText) And intCriteria = PARTIAL_MATCH)Then If intType = LABELS_ONLY Then 'выделение только меток objRowLabels.SelectLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = DATA_ONLY Then 'выделение только ячеек данных objRowLabels.SelectDataUnderLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = LABELS_AND_DATA Then objRowLabels.SelectLabelDataAt(intR, intC) bolCellsSelected = True End If End If Next intR Next intC End Sub Sub SelectColLabelsByText (strText As String, intType As Integer, intCriteria As Integer, objPivotTable As PivotTable) Dim objColumnLabels As ISpssLabels ' массив меток столбцов Dim intCol As Integer ' число столбцов в массиве Dim intRow As Integer ' число строк в массиве Dim intR As Integer ' счетчик цикла Dim intC As Integer ' счетчик цикла 'Выделение меток столбцов и (или) соответствующих ячеек данных (как запрошено) Set objColumnLabels = objPivotTable.ColumnLabelArray ' ColumnLabelArray - двумерный массив. Делаем цикл по его элементам в поисках метки, ' совпадающей с искомым текстом в переменной strText. intCol = objColumnLabels.NumColumns intRow = objColumnLabels.NumRows For intC = 0 To intCol - 1 For intR = 0 To intRow - 1 If (objColumnLabels.ValueAt(intR,intC) = strText And intCriteria = EXACT_MATCH) _ Or (InStr(objColumnLabels.ValueAt(intR,intC), strText) And intCriteria = PARTIAL_MATCH)Then If intType = LABELS_ONLY Then 'выделение только меток objColumnLabels.SelectLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = DATA_ONLY Then 'выделение только ячеек данных objColumnLabels.SelectDataUnderLabelAt(intR, intC) bolCellsSelected = True ElseIf intType = LABELS_AND_DATA Then objColumnLabels.SelectLabelDataAt(intR, intC) bolCellsSelected = True End If End If Next intR Next intC End Sub Function GetNextPivot(objPivot As PivotTable, objItem As ISpssItem) As Boolean 'Назначение: Переход к обработке следующей мобильной таблицы 'Условия: в окне результатов (Output Navigator) находятся мобильные таблицы; выдача не меняется между вызовами процедуры 'Действия: каждый вызов процедуры, активирует следующую мобильную таблицу 'Входящие параметры: ссылка на мобильную таблицу и объект, содержащий выделенную мобильную таблицу 'Исходящие параметры: активированная таблица, ссылка на объект, содержащий таблицу; значение функции "Истина", если была найдена и активирована следующая мобильная таблица 'Эта функция была написана в корп. SPSS 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