Integrate Access Tables with Excel Spredsheet to create graphs

R

ramanlally14

Hi there, my problem is that i have created a database in Access and
would like to use the information in Access to generate graphs in
Excel... I have ground knowledge in using Access as i have made a
database before but i have no idea in how to link the data to Excel so
that a graph can be created and represent the neccessary data...
Please help! am really stuck and a step-by-step guide would be amazing!
Thanks!
 
K

Ken Snell \(MVP\)

Arvin Meyer (MVP) has some code that will help you do this. He asked me to
let you know that he'll post a reply to you tonite.
 
A

Arvin Meyer [MVP]

Hi there, my problem is that i have created a database in Access and
would like to use the information in Access to generate graphs in
Excel... I have ground knowledge in using Access as i have made a
database before but i have no idea in how to link the data to Excel so
that a graph can be created and represent the neccessary data...
Please help! am really stuck and a step-by-step guide would be amazing!
Thanks!

As Ken promised, here's all the code you need. First create the Access query
that you'll be using to fill the graph and export it to the worksheet. Note
which cells are filled.

Next create a named Range based on those cells and use it as the source for
your graph.

The code will turn the graph into a gif (or jpg) which can then be used in
an Access form:

Private Sub cmdSubmitData_Click()

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 run query
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * from qryTest Where ExamID =" &
Me.txtExamID, dbOpenSnapshot)

Set appXL = New Excel.Application
Set wkb = appXL.Workbooks.Open("C:\Folder\FileName.xls")
Set wks = wkb.Worksheets(1)
'appXL.Visible = True

With wks
'Create the Column Headings
.Cells(1, 1).Value = "ExamID"
.Cells(1, 2).Value = "Patient"
.Cells(1, 3).Value = "StaffName"
.Cells(1, 4).Value = "Test_125"
.Cells(1, 5).Value = "Test_250"
.Cells(1, 6).Value = "Test_500"
.Cells(1, 7).Value = "Test_1000"
.Cells(1, 8).Value = "Test_2000"
.Cells(1, 9).Value = "Test_4000"
.Cells(1, 10).Value = "Test_8000"
.Cells(1, 11).Value = "Test2_125"
.Cells(1, 12).Value = "Test2_250"
.Cells(1, 13).Value = "Test2_500"
.Cells(1, 14).Value = "Test2_1000"
.Cells(1, 15).Value = "Test2_2000"
.Cells(1, 16).Value = "Test2_4000"
.Cells(1, 17).Value = "Test2_8000"
.Cells(1, 18).Value = "ExamDate"
'Fill Values
.Cells(2, 1).Value = rst!ExamID
.Cells(2, 2).Value = rst!FullName
.Cells(2, 3).Value = rst!StaffName
.Cells(2, 4).Value = rst![Value1]
.Cells(2, 5).Value = rst![Value2]
.Cells(2, 6).Value = rst![Value3]
.Cells(2, 7).Value = rst![Value4]
.Cells(2, 8).Value = rst![Value5]
.Cells(2, 9).Value = rst![Value6]
.Cells(2, 10).Value = rst![Value7]
.Cells(2, 11).Value = rst![Value8]
.Cells(2, 12).Value = rst![Value9]
.Cells(2, 13).Value = rst![Value10]
.Cells(2, 14).Value = rst![Value11]
.Cells(2, 15).Value = rst![Value12]
.Cells(2, 16).Value = rst![Value13]
.Cells(2, 17).Value = rst![Value14]
.Cells(2, 18).Value = rst!ExamDate
End With

DoEvents ' let the process catch up to the code

strPath = "C:\FolderName\Images\MySheet" & 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


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


Private Sub FillGraph(strPath As String)
If FileExists(strPath) = True Then
Me.imgAudiogram.Picture = strPath
Else
Me.imgAudiogram.Picture = "C:\FolderName\Images\NoImage.gif"
End If
End Sub
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top