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
'#Language "WWB-COM"
'Begin Description
'Подсветка значимых уровней в таблицах t-проверки для независимых выборок (Independent Samples Test).
'Все ячейки со значениями уровня значимости <= cSigVal будут выделены зелёным цветом.
'Условия: мобильная таблица, к которой применяется скрипт, должна быть выделена.
'Если потребуется, в строке, следующей за символами ######### ниже, можно указать желаемый порог значимости.
'End Description

'Автор: rlevesque@videotron.ca, 29.05.2001
'Посетите мою страницу, посвящённую SPSS: http://www.spsstools.net

'Размещение: http://www.spsstools.ru/Scripts/PivotTables/HighlightSignificantT-TestCells.txt (.sbs).
'Перевод: А. Балабанов, 02.01.2009.
'Проверено: SPSS 24.0.


' ВНИМАНИЕ, ВНИМАНИЕ, ВНИМАНИЕ!!!
' В SPSS 16.0 или более поздней проверьте комментарий #Uses, который расположен ниже. Важно, чтобы он содержал
' корректный путь для того, чтобы работали глобальные процедуры вроде GetFirstSelectedPivot!

'#Uses "C:\Program Files\IBM\SPSS\Statistics\23\Samples\Global.wwd"


Option Explicit

'##################
Const cSigVal=.005
'##################	

Const TextTotalStr ="2-tailed"
Const cGREEN = RGB(60, 179, 113)
Const cWHITE = RGB(255,255,255)

Sub Main

	Dim strSigVal As String
		Dim objItem As ISpssItem          		' Объект окна результатов.
		Dim objPivotTable As PivotTable         ' Мобильная таблица.
		Dim bolFoundOutputDoc As Boolean
		Dim bolPivotSelected As Boolean
		Dim s_bolCellsSelected As Boolean
		
		'Вызов процедуры GetFirstSelectedPivot для установки ссылки на выделенную мобильную таблицу
		Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutputDoc, bolPivotSelected)

		If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then
			'либо отсутствует окно результатов, либо таблица не выделена
			Exit Sub
		End If
	
		'переменная для отслеживания, были ли выделены ячейки в результате поиска
		s_bolCellsSelected = False	

		Dim objDataCells As ISpssDataCells
		Dim lngNumRows As Long
		Dim lngNumColumns As Long
		Set objDataCells = objPivotTable.DataCellArray
		' Цикл по ячейкам. Закрашиваются ячейки, значения в которых меньше или равны cSigVal:

		Dim objRowLabels As ISpssLabels         ' Массив меток строк
		Set objRowLabels = objPivotTable.RowLabelArray
		Dim objColLabels As ISpssLabels         ' Массив меток столбцов
		Set objColLabels = objPivotTable.ColumnLabelArray
		lngNumRows = objDataCells.NumRows
		lngNumColumns = objDataCells.NumColumns
		Dim I As Integer, J As Integer
		'objItem.Deactivate  ###удалено - А.Б.
		For I = 0 To lngNumRows -1
			Dim dummy As Integer
				For J = 0 To lngNumColumns -1
					If InStr (objColLabels.ValueAt(objColLabels.NumRows-1,J), TextTotalStr)> 0 Then
						If Len(objDataCells.ValueAt (I,J)) > 0 Then
							If objDataCells.ValueAt (I,J) <= cSigVal Then
								objDataCells.BackgroundColorAt (I,J) = cGREEN
							Else
								objDataCells.BackgroundColorAt  (I,J) = cWHITE
							End If
						Else
							objDataCells.BackgroundColorAt  (I,J) = cWHITE
						End If							
					End If
				Next
		Next
		' деактивация мобильной таблицы и выход
		'objItem.Activate  ###удалено - А.Б.
		objItem.Deactivate  
End Sub