'Begin Description
'Скрипт проходит по содержимому окна результатов. В каждой найденной
'мобильной таблице он ставит в пустые ячейки данных строковое значение,
'определённое пользователем (символ или несколько символов).
'End Description
'Перевод: А.Балабанов, 12.01.2009.
'Проверено: SPSS 15.0.0.
'Размещение: http://www.spsstools.ru/Scripts/PivotTables/ReplacingEmptyCells.txt (.sbs).
Option Explicit
'Здесь определяется строковая константа, значение которой будет подставляться в
'пустые ячейки данных. В данном случае - это набор символов *****.
'Источник: SPSS Script Library - Pivot Table Scripts (библиотека скриптов SPSS, раздел скриптов для обработки мобильных таблиц)
Const cVAL = "*****"
Sub Main
Dim objDocuments As ISpssDocuments ' коллекция документов SPSS.
Dim objOutputDoc As ISpssOutputDoc ' документ результатов (Output)
Dim objItems As ISpssItems ' коллекция объектов окна результатов (Output Navigator items)
Dim objPivotTable As PivotTable ' мобильная таблица (Pivot Table)
Dim i As Integer
'Ссылка на коллекцию документов SPSS.
Set objDocuments = objSpssApp.Documents
' Ставим ссылку на документ окна результатов только после проверки, что есть открытые окна результатов.
' Иначе может произойти ошибка.
If objDocuments.OutputDocCount > 0 Then
'ссылка на назначенное окно результатов
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Else
'Если нет ни одного окна результатов, выходим из скрипта.
'Чтобы избежать появления сообщения об этом, закомментируйте следующую строку.
MsgBox "Пожалуйста, создайте окно результатов перед запуском скрипта.", vbExclamation, "Ошибка выполнения скрипта"
Exit Sub
End If
' ссылка на дерево (коллекцию) объектов окна результатов
Set objItems = objOutputDoc.Items
Dim objItem As ISpssItem
' поочерёдно обрабатываем каждый объект в окне результатов
For i = 0 To objItems.Count - 1
Set objItem = objItems.GetItem(i) 'ссылка на очередной объект
If objItem.SPSSType = SPSSPivot Then 'проверяем, что объект является мобильной таблицей
Set objPivotTable = objItem.ActivateTable() 'активируем мобильную таблицу
'objPivotTable.UpdateScreen = False 'откладываем перерисовку таблицы на потом
Call ReplaceEmptyCells(objPivotTable)
objPivotTable.UpdateScreen = True
objItem.Deactivate
End If
Next
End Sub
Sub ReplaceEmptyCells (objPivotTable As PivotTable)
Dim objDataCells As ISpssDataCells
Dim lngRowNum As Long
Dim lngColNum As Long
Dim lngNumCols As Long
Dim lngNumRows As Long
'получаем ссылку на массив ячеек с данными
Set objDataCells = objPivotTable.DataCellArray()
lngNumCols = objDataCells.NumColumns
lngNumRows = objDataCells.NumRows
For lngRowNum = 0 To lngNumRows - 1
For lngColNum = 0 To lngNumCols - 1
'Далее мы, при условии, что ячейка данных вовсе пуста, или содержит пустую строку,
'ставим в неё значение строковой константы cVAL, которое определено выше
If (IsNull(objDataCells.ValueAt(lngRowNum, lngColNum))) Then
objDataCells.ValueAt(lngRowNum,lngColNum) = cVAL
objDataCells.HAlignAt(lngRowNum, lngColNum)= 4
'В предыдущей строке мы выравниваем вновь вставленное значение
'в соответствии со следующими константами выравнивания:
'0 SpssHAILeft (влево)
'1 SpssHAlRight (вправоt)
'2 SpssHAlCenter (по центру)
'3 SpssHAlMixed (смешанное) - в соответствии с типом данных - примеч. перев.
'4 SpssHAlDecimal (по десятичной точке) - для значений с десятичной точкой - примеч. перев.
ElseIf objDataCells.ValueAt(lngRowNum, lngColNum)="" Then '###
objDataCells.ValueAt(lngRowNum,lngColNum) = cVAL '### - добавлено А.Б.
objDataCells.HAlignAt(lngRowNum, lngColNum)= 1 '###
End If
Next lngColNum
Next lngRowNum
End Sub