Выделение итогов во всех таблицах

 

Загрузить как .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
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
'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
Related pages

...

Navigate from here