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
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
'Solution ID: 100008929
'Product:  SPSS Base
'Title:Automation of Pivoting

'Description:.
'I know how to reformat a particular Pivot Table manually, double-clicking to activate the
'table and dragging a Dimension icon such as "Statistics" or "Variables" in the Pivoting Tray.
'Now, can I do the same thing with a script?

'A.
'The subroutine "PivotDimensionByName" should simplify this.
'Save the portion indicated below to a Text file named, for example, "PivotDimensionByNameDemo.sbs".

'Create a PivotTable with a "Statistics" dimension, e.g. using Correlations or GLM. select it.
'Either open the "PivotDimensionByNameDemo.sbs" file in a script window and run it from there,
'or use Utilities->Run Script To Execute it.

'The subroutine can be called with any dimension name, and will search layers, rows, columns,
'or all dimensions. When it finds the dimension, it will pivot it to layers, rows, or columns,
'placing it first, last, or at a specified position.

'Modify the existing Sub Main or create your own to apply the desired pivoting to pivot tables
'as you see fit.

'Sub Main is intended only to demo PivotDimensionByName 
'Call subroutine PivotDimensionByName with parameter values: 
' objPivot: 		activated pivot table
' strDimensionName: text name of dimension to be pivoted 
' intFrom: 			where to look for dimension
' intTo: 			where to pivot dimension to
' intPosition: 		put the dimension at the location before this
'use constants PVT_LayerDimension, PVT_RowDimension, 
' PVT_ColumnDimension, PVT_AnyDimension for intFrom and intTo; 
' PVT_MoveDimensionFirst, PVT_MoveDimensionLast for intPosition 

Sub Main
Dim objPivot As PivotTable, objItem As ISpssItem 
Dim intPos As Integer 

	'intPos = PVT_MoveDimensionFirst
	intPos = PVT_MoveDimensionLast
	'intPos = 1000 'illegal value - will be ignored

	'this is just to get a Pivot Table to work with
	GetFirstSelectedPivot objPivot, objItem, True, True
	If objPivot Is Nothing Then Exit Sub

	PivotDimensionByName objPivot, "Statistics", _
		PVT_AnyDimension, PVT_LayerDimension, intPos
	ForceItemUpdate objItem
	MsgBox "Did it pivot to Layers?", vbQuestion

	Set objPivot = objItem.ActivateTable
	PivotDimensionByName objPivot, "Statistics", _
		PVT_LayerDimension, PVT_RowDimension, intPos
	ForceItemUpdate objItem
	MsgBox "Did it pivot to Rows?", vbQuestion

	Set objPivot = objItem.ActivateTable
	PivotDimensionByName objPivot, "Statistics", _
		PVT_ColumnDimension, PVT_RowDimension, intPos
	ForceItemUpdate objItem
	MsgBox "Did it pivot to Rows?", vbQuestion

End Sub

'Discard Sub Main; do not copy into your own scripts! 

'add the following subroutines to your own scripts: 
' PivotDimensionByName, 
' DoPivotDimension, 
' FindLayerDimension, 
' FindRowDimension, 
' FindColumnDimension, 
' ForceItemUpdate, 
' and associated constants 
' 

'-------------------------------------------------------- 
'BEGIN subroutines associated with PivotDimensionByName 
'-------------------------------------------------------- 
'CONSTANTS used by PivotDimensionByName subroutine 
'---- call PivotDimensionByName with intFrom and intTo 
' parameters equal to one of the following: 
Const PVT_LayerDimension As Integer = 0 
Const PVT_RowDimension As Integer = 1 
Const PVT_ColumnDimension As Integer = 2 
Const PVT_AnyDimension As Integer = 3 
'---- call PivotDimensionByName with intPosition 
' parameter equal to one of the following, 
' or a non-negative integer giving the intended position: 
Const PVT_MoveDimensionFirst As Integer = -1 
Const PVT_MoveDimensionLast As Integer = -2 
'-------------------------------------------------------- 
'Call subroutine PivotDimensionByName with parameter values: 
' objPivot: activated pivot table 
' strDimensionName: text name of dimension to be pivoted 
' intFrom: where to look for dimension 
' intTo: where to pivot dimension to 
' intPosition: put the dimension at the location 
' before this value 
'-------------------------------------------------------- 
Sub PivotDimensionByName ( _
	objPivot As PivotTable, _
	strDimensionName As String, _
	intFrom As Integer, _
	intTo As Integer, _
	intPosition As Integer)

Dim objDim As ISpssDimension 
Dim objPivotMgr As ISpssPivotMgr
Dim i As Long
Dim intNumDim As Integer 

Set objPivotMgr = objPivot.PivotManager 
Select Case intFrom 
	Case PVT_LayerDimension
		Set objDim = FindLayerDimension(objPivotMgr, strDimensionName)
	Case PVT_RowDimension
		Set objDim = FindRowDimension(objPivotMgr, strDimensionName)
	Case PVT_ColumnDimension
		Set objDim = FindColumnDimension(objPivotMgr, strDimensionName)
	Case PVT_AnyDimension
		Set objDim = FindLayerDimension(objPivotMgr, strDimensionName)
		If objDim Is Nothing Then
			Set objDim = FindRowDimension(objPivotMgr, strDimensionName)
		End If
			If objDim Is Nothing Then
			Set objDim = FindColumnDimension(objPivotMgr, strDimensionName)
		End If
	Case Else
	'trap errors while debugging
	'If Err Then MsgBox Err.Description, vbExclamation, "Error " & Err
End Select

intNumDim = NumDimensions(objPivotMgr, intTo) 
Select Case intPosition 
	Case PVT_MoveDimensionFirst
		DoPivotDimension objDim, intTo, 0
	Case PVT_MoveDimensionLast
		DoPivotDimension objDim, intTo, intNumDim
	Case 0 To intNumDim
		If Not (objDim Is Nothing) Then
			DoPivotDimension objDim, intTo, intPosition
		End If
	Case Else
	'do nothing
End Select
End Sub 

'-------------------------------------------------------- 
' subroutine associated with PivotDimensionByName 
'-------------------------------------------------------- 
Sub DoPivotDimension( _
objDim As ISpssDimension, _
intTo As Integer, intPosition As Integer)

Dim intNumDimensions As Integer 

If objDim Is Nothing Then Exit Sub 

On Error Resume Next 

	Select Case intTo
		Case PVT_LayerDimension
			objDim.MoveToLayer intPosition
		Case PVT_RowDimension
			objDim.MoveToRow intPosition
		Case PVT_ColumnDimension
			objDim.MoveToColumn intPosition
		Case Else
			Debug.Print "Unexpected Dimension type!"
	End Select
'trap errors while debugging
'If Err Then MsgBox Err.Description, vbExclamation, "Error " & Err 
End Sub 

'-------------------------------------------------------- 
' function associated with PivotDimensionByName 
'-------------------------------------------------------- 
'returns an SPSS Dimension object 
'returns Nothing if name not found 
'-------------------------------------------------------- 
Function FindLayerDimension( _
objPivotMgr As ISpssPivotMgr, _
strDimensionName As String) As ISpssDimension

Dim objDim As ISpssDimension 
Dim i As Long 

With objPivotMgr 
	For i = .NumLayerDimensions - 1 To 0 Step -1
		Set objDim = .LayerDimension(i)
		If objDim.DimensionName = strDimensionName Then
			Exit For
		End If
	Next
End With
Set FindLayerDimension = objDim 
End Function 

'-------------------------------------------------------- 
' function associated with PivotDimensionByName 
'-------------------------------------------------------- 
'returns an SPSS Dimension object 
'returns Nothing if name not found 
'-------------------------------------------------------- 
Function FindRowDimension( _
objPivotMgr As ISpssPivotMgr, _
strDimensionName As String) As ISpssDimension

Dim objDim As ISpssDimension 
Dim i As Long 

With objPivotMgr 
	For i = .NumRowDimensions - 1 To 0 Step -1
		Set objDim = .RowDimension(i)
		If objDim.DimensionName = strDimensionName Then
			Exit For
		End If
	Next
End With
Set FindRowDimension = objDim 
End Function 

'-------------------------------------------------------- 
' function associated with PivotDimensionByName 
'-------------------------------------------------------- 
'returns an SPSS Dimension object 
'returns Nothing if name not found 
'-------------------------------------------------------- 
Function FindColumnDimension( _
objPivotMgr As ISpssPivotMgr, _
strDimensionName As String) As ISpssDimension

Dim objDim As ISpssDimension 
Dim i As Long 

With objPivotMgr 
	For i = .NumColumnDimensions - 1 To 0 Step -1
		Set objDim = .ColumnDimension(i)
		If objDim.DimensionName = strDimensionName Then
			Exit For
		End If
	Next
End With
Set FindColumnDimension = objDim 
End Function 

'-------------------------------------------------------- 
' function associated with PivotDimensionByName 
'-------------------------------------------------------- 
'returns an integer giving the number of dimensions 
'returns 0 if called with inappropriate parameters 
'-------------------------------------------------------- 
Function NumDimensions( _
objPivotMgr As ISpssPivotMgr, _
intDimension As Integer) As Integer

Dim intNum As Integer 

On Error Resume Next 
	With objPivotMgr
		Select Case intDimension
		Case PVT_LayerDimension
			intNum = .NumLayerDimensions
		Case PVT_RowDimension
			intNum = .NumRowDimensions
		Case PVT_ColumnDimension
			intNum = .NumColumnDimensions
		Case Else
			'defaults to 0
		End Select
	End With
	NumDimensions = intNum
End Function 

'-------------------------------------------------------- 
' subroutine associated with PivotDimensionByName 
'-------------------------------------------------------- 
' Call this if PivotTable appearance is not correct 
' until redrawn - should not be necessary but often is. 
'-------------------------------------------------------- 
Sub ForceItemUpdate(objItem As ISpssItem) 
	With objItem
	.Deactivate
	.Activate
	.Deactivate
	End With
End Sub

'-------------------------------------------------------- 
'END * subroutines associated with PivotDimensionByName 
'--------------------------------------------------------