'Begin Description 'В выделенной таблице скрипт изменяет форматирование меток строки/столбца и соответствующих ячеек данных, 'в случае, если метка содержит слово "Total". В данной редакции информация выделяется синим и полужирным. 'Условия: выделена мобильная таблица. 'End Description 'ЭТОТ СКРИПТ СОЗДАН НА ОСНОВЕ ШАБЛОННОГО (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 objItem As ISpssItem ' Объект в окне результатов Dim objPivotTable As PivotTable ' Мобильная таблица ' Объявление переменных, используемых для разных специальных нужд 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 'Вызов процедуры GetFirstSelectedPivot для получения ссылки на первую выделенную таблицу Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutputDoc, bolPivotSelected) If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then 'либо отсутствует окно результатов, либо мобильная таблица не была выделена Exit Sub End If '************************************************************************* 'Следующий раздел выделяет ячейки, подлежащие переформатированию. 'Вы можете указать элементы таблицы, подлежащие форматированию, изменив второй аргумент 'в вызове процедур 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