none
How to copy pivot table RESULT from Access to Excel

    Question

  • I need to produce a highly formated pivot table report in Access and can only achieve so much.  However, if I could programatically select the pivot table (equivalent of keys [Ctrl]+Angel) then copy and paste into Excel, I can use VBA to format the report in Excel.

    My problem is that I cannot find a way to programatically select the pivot table in Access.  I have tried Sendkeys "^A" as a last resort but this doesn't work. Exporting to Excel doesn't work either as it exports the pivot table, not the result.

    Thursday, September 14, 2006 10:26 AM

All replies

  • Hi Rick,

    Suggest that you try send the recordset (if it is small enough) to an Excel spreadsheet with can contain your pivot table .

    I have an App which is too large for this so I work through the recordset and use VBA to write the data into the appropriate cells of my report spreadsheet. Both methods work OK

    Saturday, September 16, 2006 2:49 PM
  • Thanks for your interest however the pivot table in Access can do things which I don't think Exel can.  In particular, I do not want to perform any kind of summary analysis on the data e.g. Sum, Count etc.  The Access Pivot table can show 'detail' e.g. text as well as summarised 'data'. It is the detail I want and can produce in Access, however I also want contitional formating and a few other things which pivot table forms can't do.

    I therefore thought I would copy and paste the Access pivot table to Excel where I can complete the formatting using VBA but I am really stuck for a way to automate "Select All" i.e. pressing the "Control" key and the "A" key together.

    Every other way I have tried e.g. exporting to Excel opens an Excel Pivot table.  This applies the Count function to the text details I am reporting which is not what I want.

    Sunday, September 17, 2006 8:42 PM
  • Hi Rick,

    Have you had any luck resolving this problem?

    I am also trying to copy the results from a pivot table control and paste the results into Excel.

    KD

    Thursday, October 05, 2006 3:23 PM
  • I'm having a similar problem with a large dataset. I can export smaller result sets, but the query I'm using has over 150,000 rows: too many for Excel. However, the actual pivot table result only contains 4,500 rows

    I tried Export - didn't work, too many rows. Tried Copy & Paste, got an "Out of Memory" error

    Monday, October 09, 2006 10:45 PM
  • Try this.

    "str_spreadsheet_name" holds the name of a file that has already been exported and Excel is open and running.

    "obj_xls" then picks up the open spreadsheet.

    It then creates pivot table called "Holdings" in the Excel sheet at AQ1, with rows being "rec_id", columns being "fund_name" and pivot field being "sum of fund_value".

    It then copies the pivot table and does a patsespecial - values only. This removes all of the pivot table formatting.

    It then tidies up the headings etc. If you run the process in debug you'll be able to see it working line by line.

    Hope this is of use.

    KD

     

    Private Function reformat_fund_totals()

    On Error GoTo Err_reformat_fund_totals

    Dim rst_temp As New ADODB.Recordset

    Dim cmd_sp As New ADODB.Command

    Dim obj_xls As Object

    Dim int_rows As Integer

    Dim str_col As String

    Dim str_addr As String

    Dim objPivotCache As PivotCache

     

        DoCmd.Hourglass True

        DoCmd.Echo False

       

        Set cnn_db = CurrentProject.Connection

     

        Set obj_xls = CreateObject("Excel.Sheet")

     

        Dim start_time As Long

        Dim bool_isrunning As Boolean

        start_time = Timer

        bool_isrunning = False

       

        On Error Resume Next    ' Defer error trapping.

        Do While Timer < start_time + 30

           Set obj_xls = GetObject(str_spreadsheet_name).Application

           If Err.Number = 0 Then

              bool_isrunning = True

              Exit Do

           End If

           Err.clear    ' Clear Err object in case error occurred.

        Loop

        If bool_isrunning = False Then

            DoCmd.Hourglass False

            DoCmd.Echo True

            MsgBox "Failure formatting report " & strReport_name & " - Please inform IT", vbCritical, "SIC"

            Exit Function

        End If

     

        str_col = ""

        int_rows = 0

       

        If Forms!frm_rp05_parameters!holdings_reqd = "Y" Then

            str_sql = "EXEC sp_rpt183_fund_holdings " & pub_session_id

           

            Set cmd_sp.ActiveConnection = cnn_db

            cmd_sp.CommandText = str_sql

            cmd_sp.CommandType = adCmdText

            cmd_sp.Execute

           

            Set rst_temp.ActiveConnection = cnn_db

            rst_temp.Open cmd_sp

           

            ' Create a PivotTable cache and report.

            Set objPivotCache = obj_xls.ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)

            Set objPivotCache.Recordset = rst_temp

            With objPivotCache

                .CreatePivotTable TableDestination:=obj_xls.Range("AQ1"), TableName:="Holdings"

            End With

           

            With obj_xls.ActiveSheet.PivotTables("Holdings").PivotFields("rec_id")

                .Orientation = xlRowField

                .Position = 1

            End With

            With obj_xls.ActiveSheet.PivotTables("Holdings").PivotFields("fund_name")

                .Orientation = xlColumnField

                .Position = 1

            End With

            obj_xls.ActiveSheet.PivotTables("Holdings").AddDataField obj_xls.ActiveSheet.PivotTables("Holdings").PivotFields("fund_value"), "Sum of fund_value", xlSum

           

            DoEvents

           

            obj_xls.ActiveSheet.PivotTables("Holdings").PivotSelect "", xlDataAndLabel, True

            obj_xls.Selection.Copy

           

            obj_xls.Range("AQ1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                obj_xls.Range("AQ1:IV1").Delete Shift:=xlUp

                obj_xls.columns("AQ:AR").Delete Shift:=xlToLeft

           

            'Get last row of data

            str_addr = obj_xls.Range("A1", obj_xls.Range("A1").End(xlDown)).Address

            int_rows = Right(str_addr, Len(str_addr) - InStrRev(str_addr, "$"))

            'Get last column of data

            str_addr = obj_xls.Range("A1", obj_xls.Range("A1").End(xlToRight)).Address

            str_col = Mid(str_addr, InStrRev(str_addr, ":") + 2, Len(str_addr) - InStrRev(str_addr, "$") + 1)

           

        End If

       

        obj_xls.columns.AutoFit

        obj_xls.Rows.AutoFit

       

        obj_xls.Range("A1").select

       

        obj_xls.ActiveWorkbook.save

       

        Set obj_xls = Nothing

        Set objPivotCache = Nothing

        Set cmd_sp = Nothing

        Set rst_temp = Nothing

     

    Exit_reformat_fund_totals:

       

        DoCmd.Hourglass False

        DoCmd.Echo True

        Exit Function

     

    Err_reformat_fund_totals:

        DoCmd.Hourglass False

        DoCmd.Echo True

        If Err.Number = 2302 Then

            str_sql = "A file is already open and must be closed before this data can be exported."

            MsgBox str_sql, vbCritical, "SIC"

        End If

        MsgBox Err.description

        Resume Exit_reformat_fund_totals

    End Function

     

    Tuesday, October 10, 2006 8:37 AM