I'll agree it can get bogged down with large datasets.
The following uses the windows clipboard, speedy.
Steve
Public Sub FillDataSheetClip(GraphObject As Object, rs As DAO.Recordset)
'This will fill the datasheet of the Chart
'with data in the recordset using the Clipboard and a tab delimited
string
'RowSourceType and RowSource must be blank
Dim oSheet As Graph.DataSheet
Dim r As Integer 'row counter
Dim c As Integer 'column counter
Dim strArray As String 'used for pasting data to datasheet via clipboard
Set oSheet = GraphObject.Application.DataSheet
'clear old data
oSheet.Cells.ClearContents
'1st Row Field Names = Legend entries
For c = 0 To rs.Fields.Count - 1
strArray = strArray & rs(c).NAME & Chr(9)
Next
strArray = Left(strArray, Len(strArray) - 1) & vbCrLf
'now concatenate tab delim data rows
Do Until rs.EOF
For c = 0 To rs.Fields.Count - 1
strArray = strArray & CStr(rs(c).Value) & Chr(9)
Next
strArray = Left(strArray, Len(strArray) - 1) & vbCrLf
r = r + 1
rs.MoveNext
Loop
'copy the data string to the clipboard
SetClipboard strArray
'Paste clipboard to graph datasheet
oSheet.Cells.Paste
GraphObject.Application.Chart.Refresh
GraphObject.Application.Update
'Done!
Set oSheet = Nothing
End Sub
'paste the following clipboard code in a standard module
Declare Function pas_lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal
lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function pas_GlobalLock Lib "kernel32" Alias "GlobalLock" (ByVal
hMem As Long) As Long
Declare Function pas_GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (ByVal
hMem As Long) As Long
Declare Function pas_GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (ByVal
wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function pas_OpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal
hwnd As Long) As Long
Declare Function SetClipboardData Lib "User32.dll" (ByVal wFormat As Long,
ByVal hMem As Long) As Long
Declare Function pas_CloseClipboard Lib "user32" Alias "CloseClipboard" ()
As Long
Declare Function pas_EmptyClipboard Lib "user32" Alias "EmptyClipboard" ()
As Long
Declare Function pas_GetClipboardData Lib "user32" Alias "GetClipboardData"
(ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As
Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Public Const pas_CF_TEXT = 1
Public Const pas_GMEM_MOVEABLE = &H2
Public Const pas_GMEM_ZEROINIT = &H40
Public Const pas_GHND = (pas_GMEM_MOVEABLE Or pas_GMEM_ZEROINIT)
Public Const pas_MAXSIZE = 4096
Public Sub ClearClipboard()
On Error GoTo Err_cmdClip_Click
' Open, Empty and Close Clipboard
' No Clipboard API error handling
Call OpenClipboard(0&)
EmptyClipboard
CloseClipboard
Exit_cmdClip_Click:
Exit Sub
Err_cmdClip_Click:
MsgBox Err.Description
Resume Exit_cmdClip_Click
End Sub
Public Function SetClipboard(MyString As String)
'==========================================================================
'Description : Sets the clipboard contents
'Called By : GatherData()
'Calls : Several API calls
'Parameters : MyString as string - this is what goes into clipboard
'Returns : nothing
'Author : Peter Strong
'Date Created : 29/04/98 11:54:42
'Comments : restructured from MS KB article Q138909
'==========================================================================
On Error GoTo ProcError
Dim strActiveObjectName As String
strActiveObjectName = Application.CurrentObjectName & "SetClipboard"
Dim lngGlobalMemory As Long
Dim lngGlobalMemoryFP As Long
Dim lngClipMemory As Long
Dim lngRetVal As Long
'Allocate moveable global memory
lngGlobalMemory = pas_GlobalAlloc(pas_GHND, Len(MyString) + 1)
' Lock the block to get a far pointer to this memory
lngGlobalMemoryFP = pas_GlobalLock(lngGlobalMemory)
' Copy the string to this global memory
lngGlobalMemoryFP = pas_lstrcpy(lngGlobalMemoryFP, MyString)
' Unlock the memory
If pas_GlobalUnlock(lngGlobalMemory) = 0 Then
' Open the Clipboard to copy data to
If pas_OpenClipboard(0&) <> 0 Then
' Clear the Clipboard
lngRetVal = pas_EmptyClipboard()
' Copy the data to the Clipboard
lngClipMemory = SetClipboardData(pas_CF_TEXT, lngGlobalMemory)
Else
MsgBox "Could not open the Clipboard. Copy aborted.", vbCritical,
"Clipboard Paste"
End If
Else
MsgBox "Could not unlock memory location. Copy aborted.", vbCritical,
"Clipboard Paste"
End If
Exit_SetClipboard:
If pas_CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard.", vbCritical, "Clipboard Paste"
End If
Exit Function
ProcError:
'Error Handler Goes Here
MsgBox "Unexpected error in routine: " & strActiveObjectName & " . Error
code: " & Err & ", " & Error$, 16
Resume Exit_SetClipboard
End Function