Выделение итогов жирным шрифтом

 

Загрузить как .sbs Показать простым текстом

 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
'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
Related pages

...

Navigate from here