[AccessD] Access data to Excel Chart

Hale, Jim Jim.Hale at FleetPride.com
Wed Nov 9 09:42:21 CST 2005


Lonnie,
The fastest, easiest way to do this is from within Excel. When you create
the pivot table when it asks for the data source select "external data
source." You can then navigate to your mdb and select the query you want to
run. When it comes time to update the data simply hit refresh from the data
menu in Excel. This solution means the user runs it from Excel and doesn't
need to know anything about Access. If it is used on multiple machines the
mdb has to be available to them and the connection to the mdb should use the
network path. Also, if your query uses parameters or function calls it will
not work. The way around this is to use sub queries to provide the criteria.

The second easiest way is to create your pivot table and chart and then use
the "analyze it with excel" selection on the toolbar to dump the results to
Excel. You then cut and paste into your spreadsheet and refresh the pivot
table from the data menu. This is fast but manual.

The third way is to fully automate the process. To do this create the pivot
table and chart and store it as an Excel template without data. Then open
the Excel sheet using automation and paste the query results into the
spreadsheet. This is the best solution for the long term but of course
requires development time. Assuming you have already opened an  Excel
instance AppXcel the following function can be used to paste recordsets into
the named worksheet: (this is from a class I created to move data to Excel)

Jim Hale

Public Function PasteRecSetExcel(strSheetName As String, _
rstData As Recordset, Optional blPaste As Boolean = False, Optional
strWSRange As String) As Boolean

Dim wksUpl As Worksheet, y As Long, lngRetval As Long, blSheet As Boolean,
blRange As Boolean
On Error GoTo PROC_ERR
blSheet = SheetExists(strSheetName)
blRange = RangeNameExists(strWSRange)
If strWSRange = "" Then blRange = True
If rstData.RecordCount = 0 Then
    MsgBox rstData.Name & " is empty. There are no records to paste ", _
    vbOKOnly + vbCritical + vbSystemModal + vbDefaultButton1, _
    "Empty Recordset"
    PasteRecSetExcel = False
ElseIf blSheet = False Then
    MsgBox strSheetName & " doesn't exist.", _
    vbOKOnly + vbCritical + vbSystemModal + vbDefaultButton1, _
    "Non-existent Sheet"
    PasteRecSetExcel = False
ElseIf blRange = False Then
    MsgBox strWSRange & " is not a valid range name. No data was pasted.", _
    vbOKOnly + vbCritical + vbSystemModal + vbDefaultButton1, _
    "Range does not exist"
    PasteRecSetExcel = False
Else
    'Load Data into Excel
    Set wksUpl = appXcel.Worksheets(strSheetName)
    If strWSRange = "" Then 'if range name exists use different paste method
        If blPaste = True Then
            'true means find first empty cell before pasting the recordset
            y = appXcel.WorksheetFunction.CountA(wksUpl.Range("A:A"))
            wksUpl.Cells(y + 1, 1).CopyFromRecordset rstData
        Else
            'false means clear th sheet and paste the new data beginning in
A2
            wksUpl.Range("A2:IV65536").ClearContents
            wksUpl.Range("A2").CopyFromRecordset rstData
        End If
    Else
            wksUpl.Range(strWSRange).ClearContents
            wksUpl.Range(strWSRange).CopyFromRecordset rstData
    End If
PasteRecSetExcel = True
End If
PROC_EXIT:
    If (rstData Is Nothing) = False Then Set rstData = Nothing
    If (wksUpl Is Nothing) = False Then Set wksUpl = Nothing
  Exit Function
  
PROC_ERR:
    PasteRecSetExcel = False
    If Err.Number = 1004 Then
        MsgBox "UseExcel.Class Error: Range " & strWSRange & " does not
exist.", , _
        "PasteRecSetExcel Method"
    Else
        MsgBox "UseExcel.Class Error: " & Err.Number & ". " &
Err.Description, , _
        "PasteRecSetExcel Method"
    End If
  Resume PROC_EXIT

End Function

***********************************************************************
The information transmitted is intended solely for the individual or
entity to which it is addressed and may contain confidential and/or
privileged material. Any review, retransmission, dissemination or
other use of or taking action in reliance upon this information by
persons or entities other than the intended recipient is prohibited.
If you have received this email in error please contact the sender and
delete the material from any computer. As a recipient of this email,
you are responsible for screening its contents and the contents of any
attachments for the presence of viruses. No liability is accepted for
any damages caused by any virus transmitted by this email.


More information about the AccessD mailing list