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
'Begin Description
'Этот автоскрипт удаляет главную диагональ корреляционной матрицы, и элементы, стоящие выше её,
'  подсвечивает значимые корреляции и перемещает размерность статистик в слои (т.е. по умолчанию
'  скрывается информация о размере выборок и уровне значимости - N и Sig).
'Инструкции: замените в файле автоскриптов процедуру Correlations_Table_Correlations_Create
' процедурами и функциями, которые расположены ниже.
'Автор: Ferd Britton, 08.08.2003
'End Description

' Перевод: А. Балабанов, 26.12.2008.
' Проверено: SPSS 15.0.0
' Данные процедуры и функции, по моим сведениям, входят в стандартный файл Autoscript.sbs, поставляемый с SPSS,
' так что указанные выше сведения об авторстве и (или) дате создания, возможно, ошибочны - примеч. перев.

Sub Correlations_Table_Correlations_Create(objPivotTable As Object, objOutputDoc As Object, lngIndex As Long)
'Автоскрипт
'Вызывающее событие (Trigger Event): построение таблицы Correlations в результате вызова процедуры Correlations.
	Dim lngVarGroup As Long		'переменная будет хранить число строк на одну переменную в таблице
	Dim objCorrPivotTable As PivotTable
	Dim objDataCells As ISpssDataCells
	Dim objmanager As ISpssPivotMgr
	Dim objRow As ISpssDimension
	Set objCorrPivotTable = objPivotTable
	Set objDataCells = objCorrPivotTable.DataCellArray
	If (objDataCells.NumRows Mod objDataCells.NumColumns) = 0 Then
		'Устанавливаем флаг на запрет обновлений экрана пока модифицируем таблицу
		'Примеч.: надо вернуть флаг на место (разрешить обновления) в конце выполнения процедуры
		objCorrPivotTable.UpdateScreen = False
		
		lngVarGroup = GetVarGroupSize(objCorrPivotTable)
		'если возвращено значение -1, то имеем дело с неизвестной структурой таблицы - не можем определить количество строк на одну переменную
		If intVarGroup <> -1 Then
			'процедура, которая удаляет все элементы, за исключением стоящих ниже главной диагонали
			Call RemoveUpperDiag(objCorrPivotTable,objDataCells,lngVarGroup)
			'процедура, подсвечивающая значимые корреляции
			Call HighlightSigCorr(objCorrPivotTable, objDataCells, lngVarGroup)
		End If
	End If

	Set objmanager =objCorrPivotTable.PivotManager
	intCount = objmanager.NumRowDimensions
		For i = 0 To intCount -1
			Set objRow = objmanager.RowDimension(i)
			If objRow.DimensionName  = "Statistics" Then
				objRow.MoveToLayer(0)
			Exit For
			End If
		Next i
		'разрешаем обновления
		objCorrPivotTable.UpdateScreen = True
End Sub

Sub RemoveUpperDiag(objPivotTable As PivotTable, objDataCells As ISpssDataCells, lngVarGroupSize As Long)
'Назначение: удаляет все элементы, за исключением стоящих ниже главной диагонали
'Условия: мобильная таблица Correlations уже активирована
'Действия: скрывает все ячейки с данными, которые стоят на главной диагонали, или выше её в таблице
' Correlations, т.е. собственно коэффициенты корреляции, уровни значимости и объемы выборок N
'Входные данные: мобильная таблица Correlations, ячейки данных для этой таблицы, переменная lngVarGroupSize,
'  которая содержит число строк, занимаемых статистикой по одной переменной.
'Выходные данные: изменённая мобильная таблица Correlations
	
    Dim lngRowNum As Long
    Dim lngColNum As Long
    Dim lngNumCols As Long
    Dim lngNumRows As Long
    
    'определяем число строк и столбцов области данных
    lngNumCols = objDataCells.NumColumns
    lngNumRows = objDataCells.NumRows
    
    'этот цикл выделяет все ячейки, стоящие на и над главной диагональю в матрицах корреляций, уровней значимости и объёмов выборок.
    For lngRowNum = 0 To lngNumRows - 1
        For lngColNum = 0 To lngNumCols - 1
            If (lngColNum >= ((Int(lngRowNum/lngVarGroupSize)) Mod lngNumCols)) Then
                   objDataCells.SelectCellAt(lngRowNum, lngColNum)
            End If
        Next lngColNum
    Next lngRowNum
    
    'Теперь - скрываем данные в выделенных ячейках
    objPivotTable.TextHidden = True
    
    'Снимаем выделение
    objPivotTable.ClearSelection
    
End Sub

Sub HighlightSigCorr(objPivotTable As PivotTable, objDataCells As ISpssDataCells, lngVarGroupSize As Long)
'Назначения: подсветка значимых коэффициентов корреляции
'Условия: мобильная таблица Correlations уже активирована
'Действия: изменяет фон для ячеек, содержащих значимые корреляции
'Входные данные: мобильная таблица Correlations, массив ячеек для данной таблицы, переменная lngVarGroupSize,
' определяющая число строк на одну переменную в таблице
'Выходные данные: мобильная таблица с подсвеченными значимыми корреляциями.

    Dim lngRowNum As Long
    Dim lngColNum As Long
    Dim lngNumCols As Long
    Dim lngNumRows As Long
    Dim lngColor As Long
    Dim sngSigLevel As Single
    Dim bolCellsSelected As Boolean
	 
	bolCellsSelected = False
	
    Set objDataCells = objPivotTable.DataCellArray()
 
 	'определяем число строк и столбцов области данных.
    lngNumCols = objDataCells.NumColumns
    lngNumRows = objDataCells.NumRows

	'устанавливаем значение цвета для фона.
    lngColor = RGB (255, 255, 128) 	'желтый

	'Устанавливаем желаемый уровень значимости.
    sngSigLevel = .01

	'Цикл по ячейкам мобильной таблицы, ниже главной диагонали, содержащим уровни значимости.
	'Выделяем ячейки, значения в которых меньше указанного порога (с помощью метода SelectCellAt)
    'Затем цвет фона у выделенных ячеек будет изменён (свойством BackgroupColorAt).
    For lngRowNum = 0 To lngNumRows - 1 Step lngVarGroupSize
        For lngColNum = 0 To lngNumCols - 1
            If (lngColNum < ((Int(lngRowNum/lngVarGroupSize)) Mod lngNumCols)) Then
            If objDataCells.ValueAt(lngRowNum + 1, lngColNum)< sngSigLevel Then
            	objDataCells.SelectCellAt(lngRowNum, lngColNum)
            	bolCellsSelected = True
            End If 	
            End If
        Next lngColNum
    Next lngRowNum

	'Изменяем фон у выделенных ячеек.
	If bolCellsSelected = True Then
		objPivotTable.BackgroundColor = lngColor
	End If
    
End Sub

Function GetVarGroupSize(objPivotTable As Object) As Long
'Назначение: выяснить, какое количество строк приходится на одну переменную в полученной из процедуры Correlations таблице
'Условия: мобильная таблица Correlations уже активирована
'Действия: нет
'Входные данные: ссылка на мобильную таблицу Correlations
'Выходные данные: число строк на одну переменную
	Const FIRST_ROW As Long = 0
	
	Dim objRowLabels As ISpssLabels
	Dim lngRowNum As Long
	Dim strFirstRowLabel As String
	Dim lngLastCol As Long
	Dim bolFoundMatch As Boolean
	
	Set objRowLabels = objPivotTable.RowLabelArray
	lngLastCol = objRowLabels.NumColumns - 1
	strFirstRowLabel = CStr(objRowLabels.ValueAt(FIRST_ROW,lngLastCol))
	bolFoundMatch = False
	
	'Идём по строкам, начиная со второй, и ищем совпадение с заголовком первой строки.
	'Счётчик сохранит количество строк на одну переменную
	For lngRowNum = FIRST_ROW+1 To objRowLabels.NumRows - 1
		If CStr(objRowLabels.ValueAt(lngRowNum,lngLastCol)) = strFirstRowLabel Then
			bolFoundMatch = True
			Exit For
		End If
	Next lngRowNum
	
	If bolFoundMatch Then
		GetVarGroupSize = lngRowNum
	Else
		GetVarGroupSize = -1
	End If
	
End Function