' Экспорт таблицы результатов в редактор данных.SBS ' Данные из активного слоя выделенной таблицы результатов (Pivot Table) отсылаются в редактор данных. ' Автор: Raynald Levesque, rlevesque@videotron.ca, 2.7.2001 Sub Main Dim objPivotTable As PivotTable Dim objItem As ISpssItem Dim bolFoundOutput As Boolean, bolFoundPivot As Boolean Dim objDataCells As ISpssDataCells Dim strPivotData As String Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutput, bolFoundPivot) If Not bolFoundOutput And bolFoundPivot Then Exit Sub End If Set objDataCells = objPivotTable.DataCellArray 'Получим данные strPivotData = PivotToTab(objDataCells, _ 0, objDataCells.NumRows - 1, _ 0, objDataCells.NumColumns - 1) ' Сохраним данные в текстовый файл, а потом загрузим их в редактор данных Call ExportPivotTableDataToDataEditor (strPivotData, objDataCells.NumColumns) objItem.Deactivate End Sub Sub ExportPivotTableDataToDataEditor (strPivotData As String, lngLastColumn As Long) Dim i As Long ' процедура сохраняет данные во временный текстовый файл, а потом загружает их в редактор Open "c:\\temp\\datacells.txt" For Output As #1 Print #1, strPivotData Close #1 'Импорт из текстового файла в редактор данных Dim strCommand As String strCommand = "DATA LIST FILE='c:\\temp\\datacells.txt' LIST (TAB) /col1" For i=2 To lngLastColumn strCommand = strCommand & " col" & i Next i strCommand = strCommand &"." & vbCr strCommand= strCommand & "." & vbCr & "EXECUTE." & vbCr objSpssApp.ExecuteCommands strCommand, False End Sub Function PivotToTab(objCells As ISpssDataCells, _ lngFirstRow As Long, lngLastRow As Long, _ lngFirstColumn As Long, lngLastColumn As Long) As String Dim strWork As String Dim i As Long, j As Long On Error GoTo ErrorHandler For i = lngFirstRow To lngLastRow For j = lngFirstColumn To lngLastColumn - 1 strWork = strWork & objCells.ValueAt(i, j) & vbTab Next strWork = strWork & objCells.ValueAt(i, lngLastColumn) & vbCrLf Next PivotToTab = strWork Exit Function ErrorHandler: Debug.Print "PivotToTab: Error " & Err & vbCrLf & Err.Description Err.Clear PivotToTab = "" End Function