Pivoting to each layer of a pivot table

'Resolution number: 24365  Created On: Mar 28 2002
'Problem Subject:  Pivoting To Each layer of a pivot table In a script
'Problem Description:  I would Like To Do something In a script (export, Print, etc.) which requires All
'layers of Each pivot table To be shown. How can I pivot To make Each layer visible?

'Resolution Subject: The following subroutines may be added To your script.

'Resolution Description:
'The following subroutines may be added To your script. Simply paste the entire block
'indicated at the End of your script, after the last End Sub. Do Not add Sub Main,
'As it Is a minimalistic example which illustrates how To use the routines.

'To your script, add two New variables:

'Dim lngInitial As Long
'Dim State As PivotLayerState

'Then, where your script has identified a pivot table And you need it pivoted, place a New Line
'With a Do statement before your code which (exports, prints, etc.), And afterwards place

'Call NextCategory(State)
'ForceItemUpdate objItem
'Loop Until GetIndex(State) = lngInitial

'You should model your code On Sub Main, below.


'-----------------------------------------------------------------
' Example Sub Main illustrates use of routines to Pivot each layer
'-----------------------------------------------------------------
Sub Main
	Dim objPivot As PivotTable
	Dim objItem As ISpssItem

	Dim lngInitial As Long
	Dim State As PivotLayerState

	GetFirstSelectedPivot objPivot, objItem, True, True

	NewLayerState objPivot, State
	lngInitial = GetIndex(State)

	Do
		'--------------------------------------------------------------------
		' Please find something useful to do with the pivot table
		' This is only an example
		'--------------------------------------------------------------------
		MsgBox "Do something useful with the pivot table here", vbExclamation
		'--------------------------------------------------------------------

		Call NextCategory(State)
		ForceItemUpdate objItem
	Loop Until GetIndex(State) = lngInitial
End Sub




'-----------------------------------------------------------------
' BEGIN Routines added to pivot to each layer
'-----------------------------------------------------------------
'
'-----------------------------------------------------------------
' Type added to pivot to each layer
'-----------------------------------------------------------------
Type PivotLayerState
	Pivot As Object 'PivotTable
	PivotManager As Object 'ISpssPivotMgr
	NumLayers As Long
	NumLayerDimensions As Long
	NumCategories As Variant
	index As Long
End Type
'-----------------------------------------------------------------

Sub NewLayerState(objPivot As PivotTable, State As PivotLayerState)
	Dim i As Long
	Dim lngNumCat() As Long
	Dim lngNumLayers As Long
	Dim index As Long
	Dim objPivotMgr As ISpssPivotMgr
	Dim objDim As ISpssDimension

	Set State.Pivot = objPivot
	Set objPivotMgr = objPivot.PivotManager
	Set State.PivotManager = objPivotMgr
	State.NumLayerDimensions = objPivotMgr.NumLayerDimensions

	ReDim lngNumCat(State.NumLayerDimensions)
	lngNumLayers = 1
	'construct an index for the current state
	'save the state information along the way
	For i = 0 To State.NumLayerDimensions - 1
		Set objDim = objPivotMgr.LayerDimension(i)
		lngNumCat(i) = objDim.NumCategories
		'the test is probably unnecessary; why would a Dimension have no levels?
		If lngNumCat(i) > 0 Then
			index = index * lngNumCat(i) + objDim.CurrentCategory
			lngNumLayers = lngNumLayers * lngNumCat(i)
		End If
	Next
	State.NumLayers = lngNumLayers
	State.NumCategories = lngNumCat
	State.Index = index
End Sub

Function GetIndex(State As PivotLayerState) As Long
	'This will be valid, as long as SetIndex
	'or NewLayerState are used; i.e. never set Index directly
	GetIndex = State.Index
End Function

Sub SetIndex(State As PivotLayerState, index As Long)
	If State.Pivot Is Nothing Then Exit Sub
	If VarType(State.NumCategories ) <> vbArray + vbLong Then Exit Sub

	Dim i As Long
	Dim lngNumCat As Long
	Dim lngIndex As Long
	Dim objPivotMgr As ISpssPivotMgr
	Dim vntNumCat As Variant
	Dim objDim As ISpssDimension

	Set objPivotMgr = State.PivotManager
	vntNumCat = State.NumCategories

	lngIndex = index

	'translate back into categories
	For i = State.NumLayerDimensions - 1 To 0 Step -1
		Set objDim = objPivotMgr.LayerDimension(i)
		'if we skipped this dimension before, we'll skip it again
		lngNumCat = vntNumCat(i)
		If lngNumCat > 0 Then
			objDim.CurrentCategory = lngIndex Mod lngNumCat
			lngIndex = lngIndex \\ lngNumCat
		End If
	Next

	State.Index = index Mod State.NumLayers
End Sub

Sub NextCategory(State As PivotLayerState)
	'Cycles through *all* categories of *all* layer dimensions.
	'Advances to the next category of the bottom layer dimension.
	'When it gets to the last category of that dimension, it wraps
	'around to the first category, and it also advances to the next
	'category of the next higher dimension, and so on.

	SetIndex State, GetIndex(State) + 1
End Sub

'---------------------------------------------------------------------------
'This subroutine activates, then deactivates an Output item.
'This should be unnecessary, but will force a re-draw of the item.
'This usually corrects problems when the appearance is changed by a script.
'---------------------------------------------------------------------------
Sub ForceItemUpdate(objItem)
	On Error Resume Next
	With objItem
		.Deactivate
		.Activate
		.Deactivate
	End With
End Sub
'---------------------------------------------------------------------------

'-----------------------------------------------------------------
' END Routines added to pivot to each layer