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
'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