Create pivot table

 

Download as .sbs Shows as plain text

 

 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
'Begin Description
'This creates a new Viewer document with a pivot table inserted
'in it.  The cells of the table are populated by the script. 
'To run this script, Open SPSS And run.
'End Description

'Script level constants
Const cCOLUMN As String = "Column"
Const cCOLUMNS As String = "Columns"
Const cROW As String = "Row"
Const cROWS As String = "Rows"
Const cLAYER As String = "Layer"
Const cLAYERS As String = "Layers"
Const cNEWTABLE As String = "New table"

Sub Main
    Dim objOutputDoc As ISpssOutputDoc
    Dim objLabels As ISpssLabels      ' Column label arrays
    Dim objLayerLabels As ISpssLayerLabels      ' Column label arrays
    Dim objItems As ISpssItems
    Dim objItem As ISpssItem
    Dim objPivotTable As PivotTable
    Dim objDataCells As ISpssDataCells
    Dim objPivMgr As ISpssPivotMgr
    Dim objLayerDim As ISpssDimension
    Dim index As Long
    Dim intCol As Integer                   ' Number of columns in label array.
    Dim intRow As Integer                   ' Number of rows in label array
    Dim intLay As Integer                   ' Number of layers in table
    Dim intR As Integer                     ' Loop Counter
    Dim intC As Integer                     ' Loop Counter
    Dim intL As Integer                     ' Loop Counter
    Dim nItems As Integer
    
    
    ' Create a new Viewer window and make it visible
    Set objOutputDoc = objSpssApp.NewOutputDoc
    objOutputDoc.Visible = True

    ' Insert a blank table with 5 rows, 4 columns, 3 layers
    index = objOutputDoc.InsertTable( cNEWTABLE, 5,4,3)
    Set objItems = objOutputDoc.Items
    Set objItem = objItems.GetItem(objItems.Count-1)
    Set objPivotTable = objItem.Activate
    objPivotTable.UpdateScreen=False
        
    ' Set column labels
    Set objLabels = objPivotTable.ColumnLabelArray
    objLabels.ValueAt(0,0) = cCOLUMNS
    intCol = objLabels.NumColumns
    For intC = 0 To intCol - 1
        objLabels.ValueAt(1,intC) = cCOLUMN & " " & CStr(intC)
    Next intC
        
    ' Set row labels
    Set objLabels = objPivotTable.RowLabelArray
    objLabels.ValueAt(0,0) = cROWS
    intCol = objLabels.NumColumns
    intRow = objLabels.NumRows
    For intR = 0 To intRow - 1
        objLabels.ValueAt(intR,1) = cROW & " " & CStr(intR)
    Next intR
        
    ' Get table layer information
    Set objLayerLabels = objPivotTable.LayerLabelArray
    Set objPivMgr = objPivotTable.PivotManager
    Set objLayerDim = objPivMgr.LayerDimension(0)
    intLay = objLayerDim.NumCategories
      
    ' Set layer dimension name
    objLayerDim.DimensionName = cLAYERS

    ' Walk the layers
    For intL = intLay - 1 To 0 Step -1
      objLayerDim.CurrentCategory = intL
      
      ' Set layer labels
      objLayerLabels.ValueAt(0, 2) = cLAYER & " " & CStr(intL)
    
      ' Set data
      Set objDataCells = objPivotTable.DataCellArray
      intCol = objDataCells.NumColumns
      intRow = objDataCells.NumRows
      For intC = 0 To intCol - 1
        For intR = 0 To intRow - 1
          objDataCells.ValueAt(intR,intC) = Str(intL*100 + intC*10 + intR)
        Next intR
      Next intC
    Next intL
    
    objPivotTable.UpdateScreen=True
    objItem.Deactivate
 
End Sub
Related pages

...

Navigate from here