'Begin Description
'This script cycles through your output
'For each given Pivot Table found,
'the script will replace any empty or blank
'cell with a user-defined character or symbol
'Cells that are replaced are data cells that are
'originally missing or empty.
'End Description
Option Explicit
'Here we declare a constant to replace our empty or blank
'cells- in this example we are changing the empty or blank cell items
'to the symbol, *****, in each Pivot Table found
'Source: SPSS Script Library - Pivot Table Scripts
Const cVAL = "*****"
Sub Main
Dim objDocuments As ISpssDocuments ' SPSS documents.
Dim objOutputDoc As ISpssOutputDoc ' Output document
Dim objItems As ISpssItems ' Output Navigator items
Dim objPivotTable As PivotTable ' The Pivot Table
Dim i As Integer
'Get list of documents in SPSS.
Set objDocuments = objSpssApp.Documents
' Get designated document only if there is at least one output document.
' Omitting this test results in a error message.
If objDocuments.OutputDocCount > 0 Then
'Get the currently designated output document.
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
Else
'If no navigator window exists, quit the script.
'comment the following line out and the script will go away silently.
MsgBox "Please open an output window before running this script.", vbExclamation, "Script Error"
Exit Sub
End If
' Get the outline tree from the Navigator.
Set objItems = objOutputDoc.Items
Dim objItem As ISpssItem
' Get each item in the Navigator.
For i = 0 To objItems.Count - 1
Set objItem = objItems.GetItem(i) 'Get each item in turn.
If objItem.SPSSType = SPSSPivot Then
'Check to see if it's a PivotTable
Set objPivotTable = objItem.ActivateTable()
'Activate the pivot table.
'objPivotTable.UpdateScreen = False
'Defer drawing until later.
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
'Here we get the data cell values
Set objDataCells = objPivotTable.DataCellArray()
lngNumCols = objDataCells.NumColumns
lngNumRows = objDataCells.NumRows
For lngRowNum = 0 To lngNumRows - 1
For lngColNum = 0 To lngNumCols - 1
'Here we indicate that if a data cell value is originally missing or blank,
'set it to the constant cVAL, which we defined above
If (IsNull(objDataCells.ValueAt(lngRowNum, lngColNum))) Then
objDataCells.ValueAt(lngRowNum,lngColNum) = cVAL
objDataCells.HAlignAt(lngRowNum, lngColNum)= 1
'In the preceding line we align the replaced cell value
'using the following codes to fit the data cell alignment
'of the non-missing data cell values:
'0 SpssHAILeft (Left)
'1 SpssHAlRight (Right)
'2 SpssHAlCenter (Center)
'3 SpssHAlMixed (Mixed)
'4 SpssHAlDecimal (Decimal)
End If
Next lngColNum
Next lngRowNum
End Sub