'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