'Код решения: 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 '--------------------------------------------------------------------------- '----------------------------------------------------------------- ' КОНЕЦ процедур, предназначенных для отображения каждого слоя