Раскрытие каждого слоя таблицы перед обработкой

'Код решения: 24365, создано: 28 марта 2002 г.
'Тема: Отображение всех слоёв мобильной таблицы через скрипт
'Описание: мне требуется выполнить некоторые операции с мобильными таблицами через скрипт (экспорт, печать и т.д.),
'которые требуют того, чтобы отображались все слои таблицы. Можно ли через скрипт отобразить все слои?

'Характер решения: программный код, который пользователь может добавить в свой скрипт

'Описание решения:
'Вы можете добавить в свой скрипт предложенные ниже процедуры. Просто добавьте все процедуры, за
'исключением процедуры Main, в конец вашего скрипта (после последнего End Sub).
'Процедура Main сюда включена лишь чтобы привести маленький рабочий пример.

'В ваш скрипт потребуется добавить 2 новые переменные:

'Dim lngInitial As Long
'Dim State As PivotLayerState

'Затем, в том месте кода, где ваш скрипт уже идентифицировал нужную таблицу, слои которой требуется отобразить,
'вставьте новую строку с инструкцией Do, затем - все инструкции, которые выполняют нужные вам действия
'(экспорт, печать и т.д.), затем - следующие 4 строчки:

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

'Пример организации кода см. ниже в Sub Main.


'Перевод: А.Балабанов, 11.01.2009.
'Проверено: SPSS 15.0.0.
'Размещение: http://www.spsstools.ru/Scripts/PivotTables/PivotingToEachLayerOfPivotTable.txt (.sbs).

'См. также похожее решение: http://www.spsstools.ru/Scripts/PivotTables/CyclingThroughAllLayersOfTable.txt

'-----------------------------------------------------------------
' Пример процедуры Main иллюстрирует решение
'-----------------------------------------------------------------
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
		'--------------------------------------------------------------------
		' Здесь должны стоять ваши инструкции по обработке таблицы
		' Это - всего лишь пример.
		'--------------------------------------------------------------------
		MsgBox "Обрабатываем очередной слой таблицы", vbExclamation
		'--------------------------------------------------------------------

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




'-----------------------------------------------------------------
' НАЧАЛО процедур, предназначенных для отображения каждого слоя
'-----------------------------------------------------------------
'
'-----------------------------------------------------------------
' Определим пользовательский тип
'-----------------------------------------------------------------
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
	'Создание индекса текущего состояния слоёв (будет обновляться по ходу работы)
	For i = 0 To State.NumLayerDimensions - 1
		Set objDim = objPivotMgr.LayerDimension(i)
		lngNumCat(i) = objDim.NumCategories
		'следующая проверка, возможно, не нужна (вряд ли будем иметь размерность без единой категории)
		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
	'Функция получения индекса текущего состояния слоёв.
	'Обновлять индекс корректно только через процедуры NewLayerState/SetIndex.
	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

	'возвращаемся с уровня индекса на уровень категорий
	For i = State.NumLayerDimensions - 1 To 0 Step -1
		Set objDim = objPivotMgr.LayerDimension(i)
		'если ранее пропустили размерность, пропускаем её и сейчас
		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)
'Цикл по "всем" категориям "всех" размерностей слоёв.
'Показывает следующего категорию нижнего слоя. При достижении
'последней категории слоя, возвращается к первой категории, одновременно
'переключаясь к более высокой категории следующего слоя, и так далее.

	SetIndex State, GetIndex(State) + 1
End Sub

'---------------------------------------------------------------------------
'Эта процедура активирует, а затем - деактивирует объект окна результатов.
'Это принудительно перерисовывает объект.
'Это полезно, т.к. исправленный через скрипт объект мог вовремя не обновиться/обновиться не полностью.
'---------------------------------------------------------------------------
Sub ForceItemUpdate(objItem)
	On Error Resume Next
	With objItem
		.Deactivate
		.Activate
		.Deactivate
	End With
End Sub
'---------------------------------------------------------------------------

'-----------------------------------------------------------------
' КОНЕЦ процедур, предназначенных для отображения каждого слоя