Экспорт содержимого сводных таблиц в редактор данных

' Экспорт таблицы результатов в редактор данных.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