Подсветка значимых уровней во всех таблицах ANOVA в назначенном окне результатов

 

Загрузить как .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
' Подсветка значимых уровней во всех таблицах ANOVA (в результатах дисперсионного анализа)
' в назначенном окне результатов (Designated Viewer).
' Автор: Raynald Levesque для Manfred Straehle, 30.01.2004.

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

Sub Main
	Dim objPivot As PivotTable
	Dim objItem As ISpssItem
	Dim strLabel As String
	strLabel="ANOVA"
	Do While GetNextPivot(objPivot, objItem, strLabel)
		Call Highlight(objPivot, objItem)
	Loop
End Sub

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

Const TextTotalStr ="Sig."
Const cGREEN = RGB(60, 179, 113)
Const cWHITE = RGB(255,255,255)

Sub Highlight(objPivotTable As PivotTable , objItem As ISpssItem)
		'### строка удалена - А.Б.
		Dim bolPivotSelected As Boolean
		Dim s_bolCellsSelected As Boolean

		'значение этой переменной истинно, если в результате поиска были выделены какие-либо ячейки
		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

Function GetNextPivot(	objPivot As PivotTable, _
	objItem As ISpssItem, _
	strLabel As String ) As Boolean
'Назначение: нахождение следующей мобильной таблицы
'Условия: в окне Навигатора находятся таблицы; окно не меняет своего содержимого между вызовами функции
'Действия: каждый раз при вызове функции она выделяет и активирует следующую мобильную таблицу
'Входные данные: объект PivotTable (мобильная таблица), объект Item (элемент)-контейнер выделенной мобильной таблицы
'Выходные данные: активированная мобильная таблица, указание на выделенный элемент, функция возвращает значение "истина", если мобильная таблица найдена

'Заметьте, что функция содержит статические переменные, что позволяет осуществлять контроль перебора таблиц в окне результатов
'непосредственно в самой функции (информация о текущем положении курсора не теряется между вызовами функции).
'Кроме того, функция не только возвращает в процедуру Main своё "основное" значение (Истина/Ложь), но и переопределяет значения
'переменных objPivot и objItem, которые далее используются процедурой Main при вызове следующей процедуры (Highlight).
'При первом вызове статические переменные ещё не определены; функция контролирует это и определяет их, если требуется - примеч. перев.

	Static objDocuments As ISpssDocuments  	' коллекция документов SPSS.
	Static objOutputDoc As ISpssOutputDoc   ' документ выдачи (результатов, Output)
	Static objItems As ISpssItems       	' коллекция элементов окна выдачи (Output Navigator)
	Static intItem As Integer 		   		' индекс элемента окна Output Navigator
	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( "Не найдено окна результатов!" )
			Exit Function
		End If
	End If	' закончили с документом результатов
	
	' Ссылка на дерево элементов и подсчёт их числа
	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 не определена (Nothing): " & (objDocuments Is Nothing)
		Debug.Print "Переменная objOutputDoc не определена (Nothing): " & (objOutputDoc Is Nothing)
		Debug.Print "Переменная objItems не определена (Nothing): " & (objItems Is Nothing)
		MsgBox "Произошли ошибки при работе с документом результатов.", vbExclamation, "Функция GetNextPivot"
		Exit Function
	End If
	
	' контроль того, что документ не изменился между вызовами (на основе подсчёта числа элементов)
	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 And InStr(objItem.Label,strLabel)>0 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