Автоматизация вращения (pivoting) мобильных таблиц

'Код решения: 100008929 (SPSS AnswerNet)
'ПО:  SPSS Base
'Тема: автоматизация вращения мобильных таблиц (pivoting)

'Описание:.
'Я знаю, как можно менять структуру (вращать) мобильную таблицу (Pivot Table) вручную: двойной щелчок мышью для активации,
'затем перетаскиваем иконку размерности (например, "Statistics" или "Variables") в нужную размерность трея вращения (Pivoting Tray).
'Можно ли сделать такую же операцию через скрипт?

'Ответ.
'Да, и приводимая подпрограмма "PivotDimensionByName" упростит эту задачу.
'Сохраните порцию кода, обозначенную ниже в текстовый файл, и назовите его, скажем, "PivotDimensionByNameDemo.sbs".

'Создайте мобильную таблицу с размерностью "Statistics" (создаётся, скажем, процедурой Correlations или GLM). Выделите её.
'Далее либо откройте скрипт "PivotDimensionByNameDemo.sbs" в редакторе скриптов и запустите его, либо
'воспользуйтесь меню Utilities->Run Script для запуска того же скрипта.

'Вообще, эта подпрограмма может быть вызвана для вращения размерности с любым именем, может осуществлять поиск
'размерности с заданным именем в слоях, в строках, в столбцах (или во всех этих измерениях). Когда находится нужная размерность,
'возможно её вращение, опять же, в слои, в строки или в столбцы, со вставкой на первое место внутри измерения, на последнее, либо
'в заданную промежуточную позицию.

'Перевод: А. Балабанов, 24.11.2008.
'Проверено: SPSS 15.0.1.1. Добавлены строки с комментариями '### в функциях FindLayerDimension, FindRowDimension, FindColumnDimension,
' иначе в случае отсутствия нужной размерности они возвращали ссылку на другую (первую из имеющихся) размерность.


'Для практического использования измените приведённую ниже процедуру Sub Main в соответствие со своими потребностями.

'Приводимая ниже Sub Main - это только пример использования процедуры PivotDimensionByName
'Вызов PivotDimensionByName осуществляется со следующими параметрами:
' objPivot: 		ссылка на активированную мобильную таблицу
' strDimensionName: текст - имя размерности, подлежащей вращению (переносу в другое измерение)
' intFrom: 			где осуществлять поиск размерности
' intTo: 			куда перемещать найденную размерность
' intPosition: 		место в измерении, куда нужно вставить размерность
'можно использовать константы PVT_LayerDimension, PVT_RowDimension,
' PVT_ColumnDimension, PVT_AnyDimension для параметров intFrom и intTo;
' PVT_MoveDimensionFirst, PVT_MoveDimensionLast для параметра intPosition (описания констант см. ниже).

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

	'intPos = PVT_MoveDimensionFirst
	intPos = PVT_MoveDimensionLast
	'intPos = 1000 'недопустимое значение - будет проигнорировано

	'Следующая пара строк - просто чтобы получить ссылку на мобильную таблицу, с которой будем работать.
	GetFirstSelectedPivot objPivot, objItem, True, True
	If objPivot Is Nothing Then Exit Sub

	PivotDimensionByName objPivot, "Statistics", _
		PVT_AnyDimension, PVT_LayerDimension, intPos
	ForceItemUpdate objItem
	MsgBox "Осуществлён поворот в слои?", vbQuestion

	Set objPivot = objItem.ActivateTable
	PivotDimensionByName objPivot, "Statistics", _
		PVT_LayerDimension, PVT_RowDimension, intPos
	ForceItemUpdate objItem
	MsgBox "Осуществлён поворот в строки?", vbQuestion

	Set objPivot = objItem.ActivateTable
	PivotDimensionByName objPivot, "Statistics", _
		PVT_ColumnDimension, PVT_RowDimension, intPos
	ForceItemUpdate objItem
	MsgBox "Осуществлён поворот в строки?", vbQuestion

End Sub

'Не копируйте содержимое данной процедуры Sub Main в вашу собственную программу: это только пример!

'Вместо этого, добавьте в вашу программу следующие процедуры:
' PivotDimensionByName, 
' DoPivotDimension, 
' FindLayerDimension, 
' FindRowDimension, 
' FindColumnDimension, 
' ForceItemUpdate, 
' (и соответствующие константы)
' 

'-------------------------------------------------------- 
'НАЧАЛО кода определяющего и обслуживающего процедуру PivotDimensionByName
'-------------------------------------------------------- 
'КОНСТАНТЫ, используемые процедурой PivotDimensionByName
'---- Константы для параметров intFrom и intTo, участвующих в вызове PivotDimensionByName
' параметры могут принимать следующие значения:
Const PVT_LayerDimension As Integer = 0 'измерение слоёв
Const PVT_RowDimension As Integer = 1 'измерение строк
Const PVT_ColumnDimension As Integer = 2 'измерение столбцов
Const PVT_AnyDimension As Integer = 3 'любое измерение (все измерения)
'---- Константы для параметра intPosition
' Возможно одно из следующих двух значений,
' либо любое неотрицательное целое число, указывающее номер желаемой позиции:
Const PVT_MoveDimensionFirst As Integer = -1 'вставка первым элементом измерения
Const PVT_MoveDimensionLast As Integer = -2 'вставка последним элементом измерения
'-------------------------------------------------------- 
'Вызов процедуры PivotDimensionByName со следующими параметрами:
' objPivot: ссылка на активированную мобильную таблицу
' strDimensionName: строка с именем размерности, подвергаемой вращению
' intFrom: в каких измерениях ищем размерность
' intTo: куда будем переносить размерность
' intPosition: вставка размерности в нужное измерение перед размерностью с указанным номером
'-------------------------------------------------------- 
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
	'отлов ошибок в время отладки
	'If Err Then MsgBox Err.Description, vbExclamation, "Ошибка: " & 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
	'ничего не делаем
End Select
End Sub 

'-------------------------------------------------------- 
' процедура, обслуживающая 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 "Неверный тип размерности!"
	End Select
'отлов ошибок во время отладки
'If Err Then MsgBox Err.Description, vbExclamation, "Ошибка: " & Err
End Sub 

'-------------------------------------------------------- 
' функция, обслуживающая PivotDimensionByName (поиск в измерении слоёв)
'-------------------------------------------------------- 
'возвращает ссылку на объект SPSS Dimension (найденную размерность)
'возвращает Nothing, если размерность с нужным именем не найдена
'-------------------------------------------------------- 
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
		Else					' ### - добавлено перев.
			Set objDim=Nothing	' ### - добавлено перев.
		End If
	Next
End With
Set FindLayerDimension = objDim 
End Function 

'-------------------------------------------------------- 
' функция, обслуживающая PivotDimensionByName (поиск в измерении строк)
'-------------------------------------------------------- 
'возвращает ссылку на объект SPSS Dimension (найденную размерность)
'возвращает Nothing, если размерность с нужным именем не найдена
'-------------------------------------------------------- 
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
		Else					' ### - добавлено перев.
			Set objDim=Nothing	' ### - добавлено перев.
		End If
	Next
End With
Set FindRowDimension = objDim 
End Function 

'-------------------------------------------------------- 
' функция, обслуживающая PivotDimensionByName (поиск в измерении столбцов)
'-------------------------------------------------------- 
'возвращает ссылку на объект SPSS Dimension (найденную размерность)
'возвращает Nothing, если размерность с нужным именем не найдена
'-------------------------------------------------------- 
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
		Else					' ### - добавлено перев.
			Set objDim=Nothing	' ### - добавлено перев.
		End If
	Next
End With
Set FindColumnDimension = objDim 
End Function 

'-------------------------------------------------------- 
' функция, обслуживающая PivotDimensionByName
'-------------------------------------------------------- 
'возвращает число размерностей в измерении
'возвращает 0, если вызвана с неподходящими параметрами
'-------------------------------------------------------- 
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
			'по умолчанию - 0
		End Select
	End With
	NumDimensions = intNum
End Function 

'-------------------------------------------------------- 
' процедура, обслуживающая PivotDimensionByName
'-------------------------------------------------------- 
' Вызов, если изменённая мобильная таблица отображается некорректно
' до перерисовки: обычно не требуется, но иногда бывает полезна.
'-------------------------------------------------------- 
Sub ForceItemUpdate(objItem As ISpssItem) 
	With objItem
	.Deactivate
	.Activate
	.Deactivate
	End With
End Sub

'-------------------------------------------------------- 
'КОНЕЦ кода, определяющего и обслуживающего процедуру
'--------------------------------------------------------