' Подсветка значимых уровней во всех таблицах 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