Export pivot table data cells to data editor
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | ' 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 |
Related pages
...
Navigate from here