Поочерёдная демонстрация всех слоёв таблицы

'Решение номер 15494. Создано: 9 октября 1997 г.

'Тема: циклический показ всех слоёв в мобильной таблице

'Описание проблемы:  Часто приходится строить таблицы со множеством слоев. Иногда слоёв и категорий в них так
'много, что я путаюсь, какие из них я же просмотрел с помощью Pivoting Trays.
'Я также испытываю затруднения в нажатии на эти маленькие стрелочки для показа слоёв.
'Есть ли способ заставить программу показать один за другим все слои таблицы?

'Описание решения:
'Сохраните следующий ниже код в качестве скрипта (т.е. с расширением .sbs).
'Вам удобно будет привязать скрипт к кнопке на панели инструментов SPSS
'для быстрого его запуска.
'Для использования: выделите нужную таблицу и запустите скрипт.
'Скрипт отобразит следующую категорию низшего слоя, исходя из текущего
'состояния таблицы. В случае, если достигнута последняя категория низшего слоя,
'скрипт переключается на первую категорию низшего слоя, одновременно переключаясь
'к следующей категории слоя, следующего за низшим. И так далее.
'После достаточного числа запусков скрипта все категории всех слоёв
'будут просмотрены и таблица возвратится к исходному состоянию.

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


'**********************************************************
Sub Main
	' Объявление объектных переменных, используемых в процедуре
	Dim objItem As ISpssItem ' Элемент Навигатора (окна результатов)
	Dim objPivotTable As PivotTable ' мобильная таблица
	Dim bolFoundOutputDoc As Boolean
	Dim bolPivotSelected As Boolean

	'Вызов глобальной процедуры GetSelectedTable для установки ссылки на выделенную таблицу
	Call GetFirstSelectedPivot(objPivotTable, objItem, _
	bolFoundOutputDoc, bolPivotSelected)

	If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then
		'либо отсутствует окно результатов, либо нет выделенной таблицы
		Exit Sub
	End If

	' запрет обновления экрана до завершения преобразований с таблицей
	objPivotTable.UpdateScreen = False

	'**********************************************************

	' смысловая часть
	Call NextCategory(objPivotTable)

	'**********************************************************
	'разрешение обновления экрана
	objPivotTable.UpdateScreen = True
	' деактивация таблицы и выход
	objItem.Deactivate

End Sub


Sub NextCategory(objPivotTable As PivotTable)
'Цикл по "всем" категориям "всех" размерностей слоёв.
'Показывает следующего категорию нижнего слоя. При достижении
'последней категории слоя, возвращается к первой категории, одновременно
'переключаясь к более высокой категории следующего слоя, и так далее.

	Dim objPivotMgr As ISpssPivotMgr
	Dim objDim As ISpssDimension

	Dim lngNumLayerDimensions As Long
	Dim lngNumCat() As Long
	Dim i As Long
	Dim index As Long

	Set objPivotMgr = objPivotTable.PivotManager

	lngNumLayerDimensions = objPivotMgr.NumLayerDimensions

	ReDim lngNumCat(lngNumLayerDimensions)

	'во-первых, строим индекс текущего состояния таблицы
	For i = 0 To lngNumLayerDimensions - 1
	Set objDim = objPivotMgr.LayerDimension(i)
	lngNumCat(i) = objDim.NumCategories
		'следующая проверка, возможно, лишняя:
		'почему бы размерности не иметь категорий?
		If lngNumCat(i) > 0 Then
		index = index * lngNumCat(i) + objDim.CurrentCategory
		End If
	Next

	'увеличиваем индекс
	index = index + 1

	'возвращаемся с уровня индекса на уровень категорий
	For i = lngNumLayerDimensions - 1 To 0 Step -1
		Set objDim = objPivotMgr.LayerDimension(i)
		'если ранее пропустили размерность, пропускаем её и сейчас
		If lngNumCat(i) > 0 Then
			objDim.CurrentCategory = index Mod lngNumCat(i)
			index = index \\ lngNumCat(i)
		End If
	Next

End Sub