Here's all the code you'll need. Builds a recordset, sends the data to an
Excel range, creates a graph image, sends it back to the Access form. All
the code is run from the Access form:
Private Sub cmdSubmitData_Click()
'© Arvin Meyer 2003 to 2006
'Permission granted for use as long as copyright is in tact
Dim appXL As Excel.Application
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim chtXL As Excel.Chart
Dim strPath As String
On Error GoTo Error_Handler
' Open the current database and query
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * from qryMyQuery Where ID =" &
Me.txtID, dbOpenSnapshot)
Set appXL = New Excel.Application
Set wkb = appXL.Workbooks.Open("C:\MyWorkbook.xls")
Set wks = wkb.Worksheets(1)
'appXL.Visible = True
With wks
'Create the Column Headings
.Cells(1, 1).Value = "ID"
.Cells(1, 2).Value = "FullMame"
.Cells(1, 3).Value = "StaffName"
.Cells(1, 4).Value = "L125"
.Cells(1, 5).Value = "L150"
.Cells(1, 6).Value = "L500"
.Cells(1, 7).Value = "L1000"
.Cells(1, 8).Value = "L2000"
.Cells(1, 9).Value = "L4000"
.Cells(1, 10).Value = "L8000"
.Cells(1, 11).Value = "R125"
.Cells(1, 12).Value = "R250"
.Cells(1, 13).Value = "R500"
.Cells(1, 14).Value = "R1000"
.Cells(1, 15).Value = "R2000"
.Cells(1, 16).Value = "R4000"
.Cells(1, 17).Value = "R8000"
.Cells(1, 18).Value = "DateField"
'Fill Values
.Cells(2, 1).Value = rst!ID
.Cells(2, 2).Value = rst!FullName
.Cells(2, 3).Value = rst!StaffName
.Cells(2, 4).Value = rst![ACL125]
.Cells(2, 5).Value = rst![ACL250]
.Cells(2, 6).Value = rst![ACL500]
.Cells(2, 7).Value = rst![ACL1000]
.Cells(2, 8).Value = rst![ACL2000]
.Cells(2, 9).Value = rst![ACL4000]
.Cells(2, 10).Value = rst![ACL8000]
.Cells(2, 11).Value = rst![ACR125]
.Cells(2, 12).Value = rst![ACR250]
.Cells(2, 13).Value = rst![ACR500]
.Cells(2, 14).Value = rst![ACR1000]
.Cells(2, 15).Value = rst![ACR2000]
.Cells(2, 16).Value = rst![ACR4000]
.Cells(2, 17).Value = rst![ACR8000]
.Cells(2, 18).Value = rst!DateField
End With
DoEvents
strPath = "C:\Images\FileName" & wks.Cells(2, 1) & ".gif"
' Build a GIF image from the Excel chart
If FileExists(strPath) Then
Kill strPath
End If
Set chtXL = wks.ChartObjects(2).Chart
chtXL.Export FileName:=strPath, FilterName:="GIF"
DoEvents
'Rebuild the image on the form
FillGraph (strPath)
Exit_Here:
wkb.Close xlDoNotSaveChanges
Set wkb = Nothing
Set appXL = Nothing
rst.Close
Set rst = Nothing
Set db = Nothing
Exit Sub
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Here
End Sub
Private Sub FillGraph(strPath As String)
If FileExists(strPath) = True Then
Me.imgControlName.Picture = strPath
Else
Me.imgControlName.Picture = "C:\Images\NoImage.gif"
End If
End Sub
Public Function FileExists(strPath As String) As Integer
On Error Resume Next
Dim intLen As Integer
intLen = Len(Dir(strPath))
FileExists = (Not Err And intLen > 0)
End Function
--
Arvin Meyer, MCP, MVP
Free MS-Access downloads:
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com