'Begin Description 'Создаёт новое окно результатов и вставляет туда мобильную таблицу. 'Содержимое таблицы определяется в скрипте. 'Для запуска скрипта - откройте SPSS, откройте данный файл скрипта и запустите его. 'End Description ' Размещение: http://www.spsstools.ru/Scripts/PivotTables/CreatePivotTable.txt (.sbs) ' Перевод: А. Балабанов, 29.12.2008. 'Определения констант на уровне скрипта Const cCOLUMN As String = "Столбец" Const cCOLUMNS As String = "Столбцы" Const cROW As String = "Строка" Const cROWS As String = "Строки" Const cLAYER As String = "Слой" Const cLAYERS As String = "Слои" Const cNEWTABLE As String = "Новая таблица" Sub Main Dim objOutputDoc As ISpssOutputDoc Dim objLabels As ISpssLabels ' переменная для массива меток строк и столбцов Dim objLayerLabels As ISpssLayerLabels ' переменная для массива меток слоев Dim objItems As ISpssItems Dim objItem As ISpssItem Dim objPivotTable As PivotTable Dim objDataCells As ISpssDataCells Dim objPivMgr As ISpssPivotMgr Dim objLayerDim As ISpssDimension Dim index As Long Dim intCol As Integer ' число столбцов в массиве меток Dim intRow As Integer ' число строк в массиве меток Dim intLay As Integer ' число слоев в таблице Dim intR As Integer ' счетчик цикла Dim intC As Integer ' счетчик цикла Dim intL As Integer ' счетчик цикла Dim nItems As Integer ' Создаём новое окно редактора результатов и делаем его видимым Set objOutputDoc = objSpssApp.NewOutputDoc objOutputDoc.Visible = True ' Вставляем пустую таблицу с 5 строками, 4 столбцами и 3 слоями index = objOutputDoc.InsertTable( cNEWTABLE, 5,4,3) Set objItems = objOutputDoc.Items Set objItem = objItems.GetItem(objItems.Count-1) Set objPivotTable = objItem.Activate objPivotTable.UpdateScreen=False ' Расставляем метки столбцов Set objLabels = objPivotTable.ColumnLabelArray objLabels.ValueAt(0,0) = cCOLUMNS intCol = objLabels.NumColumns For intC = 0 To intCol - 1 objLabels.ValueAt(1,intC) = cCOLUMN & " " & CStr(intC) Next intC ' Расставляем метки строк Set objLabels = objPivotTable.RowLabelArray objLabels.ValueAt(0,0) = cROWS intCol = objLabels.NumColumns intRow = objLabels.NumRows For intR = 0 To intRow - 1 objLabels.ValueAt(intR,1) = cROW & " " & CStr(intR) Next intR ' Расстановка ссылок по объектным переменным для управления слоями Set objLayerLabels = objPivotTable.LayerLabelArray Set objPivMgr = objPivotTable.PivotManager Set objLayerDim = objPivMgr.LayerDimension(0) intLay = objLayerDim.NumCategories ' Установка имени размерности objLayerDim.DimensionName = cLAYERS ' Пробежка по слоям For intL = intLay - 1 To 0 Step -1 objLayerDim.CurrentCategory = intL ' Помечаем слои objLayerLabels.ValueAt(0, 2) = cLAYER & " " & CStr(intL) ' Наполняем таблицу данными Set objDataCells = objPivotTable.DataCellArray intCol = objDataCells.NumColumns intRow = objDataCells.NumRows For intC = 0 To intCol - 1 For intR = 0 To intRow - 1 objDataCells.ValueAt(intR,intC) = Str(intL*100 + intC*10 + intR) Next intR Next intC Next intL objPivotTable.UpdateScreen=True objItem.Deactivate End Sub