' Export Pivot Table Data To Data Editor.SBS
' The data in the current layer of the currently selected Pivot Table is sent to the Data Editor.
' Raynald Levesque rlevesque@videotron.ca 2001/07/02

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
  
		'Get data      
        strPivotData = PivotToTab(objDataCells, _
                0, objDataCells.NumRows - 1, _
                0, objDataCells.NumColumns - 1)
		
		' Save data to txt file then bring the data into the Data Editor
		Call ExportPivotTableDataToDataEditor (strPivotData, objDataCells.NumColumns)
		objItem.Deactivate	
End Sub

Sub  ExportPivotTableDataToDataEditor (strPivotData As String, lngLastColumn As Long)
        Dim i As Long
        ' This saves the data into a temporary text file then bring it into the Data Editor
 	 	Open "c:\\temp\\datacells.txt" For Output As #1
        Print #1, strPivotData      
		Close #1
             
		'Bring the Text file into the Data Editor
        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