Replacing Empty Cells of Pivot Tables by user-defined characters
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 |
Related pages
...