Using Access to create dynamic chart in Excel

[Guest]

I am trying to create a dynamic chart on an Excel sheet via the code below
and cannot get it to work. I use the TransferSpreadsheet method to create the
Excel file and then open it in code

Here is some sample data from the sheet that is created:

Site Function Attendance Trainer Raiting Asmt 1 Asmt 2 Asmt 3
S1 F1 1 1.4 0 1.1 0 0
S1 F2 0 0 0 2 0 0
S1 F3 1 1.45 0 1.5 0 0

There could be any number of rows, but always the same # of columns. And
there will always be at least 1 row.

I want a simple bar graph with the title being "TEMPE ASSESSMENT TRAINER".
The position and the size of the chart to be Left:=390, Width:=300, Top:=5,
Height:=200. The X values from 0.00 to 3.5 at .5 intervals. The function to
be the Category axis at the bottom. The Trainer column to be the Series 1
data.

The code below is slightly modified code from a macro that craps out at the
16th line (the SetSourceData line) with this error:

"Methods 'Sheets' of object '_Global' failed"


**SAMPLE CODE**

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qryUserPrepReadinessBySiteAndFunction9", "C:\VCCT Training DB\Employee
Readiness Results Report.xls", True

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

Set objActiveWkb = objXL.Workbooks.Open("C:\VCCT Training DB\Employee
Readiness Results Report.xls")

Set objActiveWkb = objXL.Application.ActiveWorkbook

objActiveWkb.Worksheets("qryUserPrepReadinessBySiteAndFu").Cells(1,
1).Select

objXL.Visible = True

Dim myChtObj As ChartObject

Set myChtObj =
objActiveWkb.Worksheets("qryUserPrepReadinessBySiteAndFu").ChartObjects.Add(Left:=390, Width:=300, Top:=5, Height:=200)

myChtObj.Chart.ChartType = xlColumnClustered

myChtObj.SetSourceData
Source:=Sheets("qryUserPrepReadinessBySiteAndFu").Range("A1:G4"),
PlotBy:=xlRows

myChtObj.SeriesCollection.NewSeries

myChtObj.SeriesCollection(1).XValues =
"=qryUserPrepReadinessBySiteAndFu!R2C2:R4C2"

myChtObj.SeriesCollection(1).Values =
"=qryUserPrepReadinessBySiteAndFu!R2C4:R4C4"

myChtObj.SeriesCollection(1).Name =
"=qryUserPrepReadinessBySiteAndFu!R1C4"

myChtObj.Location Where:=xlLocationAsObject,
Name:="qryUserPrepReadinessBySiteAndFu"

With myChtObj.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With

With myChtObj.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With

myChtObj.HasLegend = False

myChtObj.HasDataTable = False


Any help with getting this to work would be most appreciated.

Much thanks!
Clint Herman

 

[TC]

This is really an Excel question, not an Access one.

I'd try asking in an Excel newsgroup. Those folks would generally know
more than us, about Excel VBA.

HTH,
TC (MVP Access)
ttp://tc2.atspace.com

 

[Guest]

Thanks for the idea, but I posted in the Excel forum and all I got were some
links. I've spent a lot of time trying to figure this out and thought maybe
someone else here has created charts dynamically and passed them to Excel.

Clint

 

[Ed Adamthwaite]

Hi cherman,
Below is an example of how to create a chart in Excel from Access.
Step through the code and you'll see what's going on.
First off, create a table called Table1 and give it the following field
names and data:
Table1
DataSeries1 DataSeries2
1 5
2 25
3 9
4 8
5 3
6 2
7 5
8 9
9 11
10 6
11 4
12 5
13 6
14 7
15 8
16 9
17 10
18 11
19 13
20 15
Set a reference to Excel under Tools|References in the VBA IDE.
Copy the following to a standard module:
Sub CreateXLChart()
On Error GoTo ErrorHandler
Dim xLApp As Excel.Application
Dim wb As Excel.Workbook
Dim db As Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim iRowCount As Integer
Dim iBorder As Integer
Dim iFieldNum As Integer
Dim iRecordCount As Integer
Dim s As String
Dim sSQL As String
Dim sDate As String
Dim sPath As String
Dim sFile As String
Dim sSysMsg As String
Dim vSysCmd As Variant
sSysMsg = "Creating Excel Chart Test"
Set xLApp = New Excel.Application
Set wb = xLApp.Workbooks.Add()
Set db = CurrentDb
sDate = Format(Date, "dd-mm-yyyy")
sPath = "C:\"
sFile = "Excel Chart Test"
'open a recordset from database
sSQL = "SELECT DataSeries1, DataSeries2 " _
& "FROM Table1 " _
& "ORDER BY ID;"
'Debug.Print sSQL
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot) With rs
..MoveLast 'force error 3021 if no records
..MoveFirst
iRecordCount = .RecordCount
vSysCmd = SysCmd(acSysCmdInitMeter, sSysMsg, iRecordCount) End With
xLApp.Visible = True With wb.Worksheets(1)
..Name = "ChartData"
..Cells(1, 1).Value = "Excel Chart Test"

i = 2
' Set the field names
For iFieldNum = 1 To rs.Fields.Count
..Cells(i, iFieldNum).Value = rs.Fields(iFieldNum - 1).Name
Next
i = i + 1
Do Until rs.EOF
For iFieldNum = 1 To rs.Fields.Count
..Cells(i, iFieldNum).Value = Nz(rs.Fields(iFieldNum - 1), "")
Next
vSysCmd = SysCmd(acSysCmdUpdateMeter, i)
i = i + 1
rs.MoveNext
Loop
iRowCount = i - 1
With xLApp
..Charts.Add
With .ActiveChart
..ChartType = xlLineMarkers
..SeriesCollection.NewSeries
..SeriesCollection(1).Name = "Series1" & Chr(10) & "Straight" & Chr(10) &
"Stuff"
..SeriesCollection(1).Values = "=ChartData!R3C1:R22C1"
..SeriesCollection(2).Name = "Series2" & Chr(10) & "Wobbly" & Chr(10) &
"Stuff"
..SeriesCollection(2).Values = "=ChartData!R3C2:R22C2"
..HasTitle = True
..ChartTitle.Caption = "cherman's Straight & Wobbly Stuff"
With .Axes(xlCategory, xlPrimary)
..HasTitle = True
..AxisTitle.Characters.Text = "cherman's Horizontal Axis"
End With
With .Axes(xlValue, xlPrimary)
..HasTitle = True
..AxisTitle.Characters.Text = "cherman's Vertical Axis"
End With
'change orientation of Category Axis text
With .Axes(xlCategory).TickLabels
..Alignment = xlCenter
..Offset = 100
..Orientation = xlHorizontal
End With
..HasLegend = True
..Legend.Position = xlBottom
..Location Where:=xlLocationAsObject, Name:="ChartData"
End With
'move chart around
' .ActiveSheet.Shapes("Chart 1").IncrementLeft 10
..ActiveSheet.Shapes("Chart 1").IncrementTop -90
End With
'do some text alignment and formatting
With .Range("A2:B22")
..HorizontalAlignment = xlCenter
..VerticalAlignment = xlBottom
End With
..Range("A1:B2").Font.Bold = True
..Range("A:B").EntireColumn.AutoFit
'Pagesetup stuff
With .PageSetup
..LeftFooter = "Created &T &D"
..CenterFooter = "&P of &N"
..LeftMargin = xLApp.InchesToPoints(0.42)
..RightMargin = xLApp.InchesToPoints(0.47)
..TopMargin = xLApp.InchesToPoints(0.52)
..BottomMargin = xLApp.InchesToPoints(0.55)
..HeaderMargin = xLApp.InchesToPoints(0.5)
..FooterMargin = xLApp.InchesToPoints(0.35)
..PrintTitleRows = "$1:$2"
..PrintComments = xlPrintNoComments
..PrintQuality = 600
..Orientation = xlLandscape
..PaperSize = xlPaperA4
..FirstPageNumber = xlAutomatic
..Order = xlDownThenOver
End With
'format borders
With .Range("A2:B22")
For iBorder = 7 To 11
..Borders(iBorder).LineStyle = xlContinuous
Next
..Borders(xlInsideHorizontal).LineStyle = xlDot
End With
With .Range("A2:B2")
For iBorder = 7 To 10
..Borders(iBorder).LineStyle = xlContinuous
Next
End With
..Range("A1").Select
End With
'Save File
wb.SaveAs sPath & sFile & " " & sDate & ".xls"
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case 3021
Case Else
MsgBox "Problem with CreateXLChart()" & vbCrLf _
& "Error " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
'if no records then clean up excel
vSysCmd = SysCmd(acSysCmdClearStatus)
If iRecordCount = 0 Then
wb.Close SaveChanges:=False
xLApp.Quit
End If
'clean up objects
Set wb = Nothing
Set xLApp = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Run it and have fun.
Regards,
Ed.
..

 

[Guest]

Thank you SO much for taking the time to create and post this! With only a
few mods to the code, it worked like a charm and will provide me all that I
need to get my code working.

Thanks again!

Clint Herman

 

[Guest]

Hi there. I have now completely incorporated your code into my DB and have
added several other lines of code. It's running smooth.

However, I cannot figure out how to do 2 things.

I want to resize the chart, but I get errors when I use code like the
following:

ActiveSheet.Shapes("Chart 1").ScaleWidth 0.83, msoFalse, msoScaleFromTopLeft

I've removed the last 2 parameters from the code and I still generate an
error.

How can I resize the chart?

Also, I want to set the position of the chart by using absolutes, like with
(Left:=390, Width:=300, Top:=5, Height:=200). Can I do something like this?

Thanks,
Clint

 

[Ed Adamthwaite]

Hi again cherman,
Look for the area in the code for the line "'move chart around "

'move chart around

Remove or comment the following lines:
' .ActiveSheet.Shapes("Chart 1").IncrementLeft 10
' .ActiveSheet.Shapes("Chart 1").IncrementTop -90

Replace them with:

With .ActiveSheet.Shapes("Chart 1")
.Left = 390
.Width = 300
.Top = 5
.Height = 200
End With

HTH
cheers,
Ed.

 

[Guest]

Perfect!

Thank you once again,
Clint

Hi again cherman,
Look for the area in the code for the line "'move chart around "

'move chart around

Remove or comment the following lines:
' .ActiveSheet.Shapes("Chart 1").IncrementLeft 10
' .ActiveSheet.Shapes("Chart 1").IncrementTop -90

Replace them with:

With .ActiveSheet.Shapes("Chart 1")
.Left = 390
.Width = 300
.Top = 5
.Height = 200
End With

HTH
cheers,
Ed.

 

[Guest]

I used the code that was posted on here, but i am receiving an error. "Error
3021: Too few parameters. Expected 1." I posted the code that i used below.
Thank you for any help you can provide.

Sub CreateXLChart()
On Error GoTo ErrorHandler
Dim xLApp As Excel.Application
Dim wb As Excel.Workbook
Dim db As Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim iRowCount As Integer
Dim iBorder As Integer
Dim iFieldNum As Integer
Dim iRecordCount As Integer
Dim s As String
Dim sSQL As String
Dim sDate As String
Dim sPath As String
Dim sFile As String
Dim sSysMsg As String
Dim vSysCmd As Variant
sSysMsg = "Creating Excel Chart Test"
Set xLApp = New Excel.Application
Set wb = xLApp.Workbooks.Add()
Set db = CurrentDb
sDate = Format(Date, "dd-mm-yyyy")
sPath = "C:\"
sFile = "Excel Chart Test"
'open a recordset from database
sSQL = "SELECT DataSeries1, DataSeries2 " _
& "FROM Table1 " _
& "ORDER BY ID;"
'Debug.Print sSQL
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
With rs
Move.Last 'force error 3021 if no records
Move.First
iRecordCount = .RecordCount
vSysCmd = SysCmd(acSysCmdInitMeter, sSysMsg, iRecordCount)
End With
xLApp.Visible = True
With wb.Worksheets(1)
'Name = "ChartData"
Cells(1, 1).Value = "Excel Chart Test"

i = 2
' Set the field names
For iFieldNum = 1 To rs.Fields.Count
Cells(i, iFieldNum).Value = rs.Fields(iFieldNum - 1).Name
Next
i = i + 1
Do Until rs.EOF
For iFieldNum = 1 To rs.Fields.Count
Cells(i, iFieldNum).Value = Nz(rs.Fields(iFieldNum - 1), "")
Next
vSysCmd = SysCmd(acSysCmdUpdateMeter, i)
i = i + 1
rs.MoveNext
Loop
iRowCount = i - 1
With xLApp
Charts.Add
With .ActiveChart
ChartType = xlLineMarkers
SeriesCollection.NewSeries
SeriesCollection(1).Name = "Series1" & Chr(10) & "Straight" & Chr(10) &
"Stuff"
SeriesCollection(1).Values = "=ChartData!R3C1:R22C1"
SeriesCollection(2).Name = "Series2" & Chr(10) & "Wobbly" & Chr(10) &
"Stuff"
SeriesCollection(2).Values = "=ChartData!R3C2:R22C2"
HasTitle = True
ChartTitle.Caption = "cherman's Straight & Wobbly Stuff"
With .Axes(xlCategory, xlPrimary)
HasTitle = True
AxisTitle.Characters.Text = "cherman's Horizontal Axis"
End With
With .Axes(xlValue, xlPrimary)
HasTitle = True
AxisTitle.Characters.Text = "cherman's Vertical Axis"
End With
'change orientation of Category Axis text
With .Axes(xlCategory).TickLabels
Alignment = xlCenter
Offset = 100
Orientation = xlHorizontal
End With
HasLegend = True
Legend.Position = xlBottom
'Location Where:=xlLocationAsObject, Name:="ChartData"
End With
'move chart around
ActiveSheet.Shapes("Chart 1").IncrementLeft 10
ActiveSheet.Shapes("Chart 1").IncrementTop -90
End With
'do some text alignment and formatting
With .Range("A2:B22")
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
End With
Range("A1:B2").Font.Bold = True
Range("A:B").EntireColumn.AutoFit
'Pagesetup stuff
With .PageSetup
LeftFooter = "Created &T &D"
CenterFooter = "&P of &N"
LeftMargin = xLApp.InchesToPoints(0.42)
RightMargin = xLApp.InchesToPoints(0.47)
TopMargin = xLApp.InchesToPoints(0.52)
BottomMargin = xLApp.InchesToPoints(0.55)
HeaderMargin = xLApp.InchesToPoints(0.5)
FooterMargin = xLApp.InchesToPoints(0.35)
PrintTitleRows = "$1:$2"
PrintComments = xlPrintNoComments
PrintQuality = 600
Orientation = xlLandscape
PaperSize = xlPaperA4
FirstPageNumber = xlAutomatic
Order = xlDownThenOver
End With
'format borders
'With .Range("A2:B22")
'For iBorder = 7 To 11
' Borders(iBorder).LineStyle = xlContinuous
'Next
' Borders(xlInsideHorizontal).LineStyle = xlDot
'End With
'With .Range("A2:B2")
'For iBorder = 7 To 10
' Borders(iBorder).LineStyle = xlContinuous
'Next
'End With
Range("A1").Select
End With
'Save File
wb.SaveAs sPath & sFile & " " & sDate & ".xls"
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case 3021
Case Else
MsgBox "Problem with CreateXLChart()" & vbCrLf _
& "Error " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
'if no records then clean up excel
vSysCmd = SysCmd(acSysCmdClearStatus)
If iRecordCount = 0 Then
wb.Close SaveChanges:=False
xLApp.Quit
End If
'clean up objects
Set wb = Nothing
Set xLApp = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

 

[Guest]

Sorry the error is 3061, not 3021

I used the code that was posted on here, but i am receiving an error. "Error
3021: Too few parameters. Expected 1." I posted the code that i used below.
Thank you for any help you can provide.

Sub CreateXLChart()
On Error GoTo ErrorHandler
Dim xLApp As Excel.Application
Dim wb As Excel.Workbook
Dim db As Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim iRowCount As Integer
Dim iBorder As Integer
Dim iFieldNum As Integer
Dim iRecordCount As Integer
Dim s As String
Dim sSQL As String
Dim sDate As String
Dim sPath As String
Dim sFile As String
Dim sSysMsg As String
Dim vSysCmd As Variant
sSysMsg = "Creating Excel Chart Test"
Set xLApp = New Excel.Application
Set wb = xLApp.Workbooks.Add()
Set db = CurrentDb
sDate = Format(Date, "dd-mm-yyyy")
sPath = "C:\"
sFile = "Excel Chart Test"
'open a recordset from database
sSQL = "SELECT DataSeries1, DataSeries2 " _
& "FROM Table1 " _
& "ORDER BY ID;"
'Debug.Print sSQL
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
With rs
Move.Last 'force error 3021 if no records
Move.First
iRecordCount = .RecordCount
vSysCmd = SysCmd(acSysCmdInitMeter, sSysMsg, iRecordCount)
End With
xLApp.Visible = True
With wb.Worksheets(1)
'Name = "ChartData"
Cells(1, 1).Value = "Excel Chart Test"

i = 2
' Set the field names
For iFieldNum = 1 To rs.Fields.Count
Cells(i, iFieldNum).Value = rs.Fields(iFieldNum - 1).Name
Next
i = i + 1
Do Until rs.EOF
For iFieldNum = 1 To rs.Fields.Count
Cells(i, iFieldNum).Value = Nz(rs.Fields(iFieldNum - 1), "")
Next
vSysCmd = SysCmd(acSysCmdUpdateMeter, i)
i = i + 1
rs.MoveNext
Loop
iRowCount = i - 1
With xLApp
Charts.Add
With .ActiveChart
ChartType = xlLineMarkers
SeriesCollection.NewSeries
SeriesCollection(1).Name = "Series1" & Chr(10) & "Straight" & Chr(10) &
"Stuff"
SeriesCollection(1).Values = "=ChartData!R3C1:R22C1"
SeriesCollection(2).Name = "Series2" & Chr(10) & "Wobbly" & Chr(10) &
"Stuff"
SeriesCollection(2).Values = "=ChartData!R3C2:R22C2"
HasTitle = True
ChartTitle.Caption = "cherman's Straight & Wobbly Stuff"
With .Axes(xlCategory, xlPrimary)
HasTitle = True
AxisTitle.Characters.Text = "cherman's Horizontal Axis"
End With
With .Axes(xlValue, xlPrimary)
HasTitle = True
AxisTitle.Characters.Text = "cherman's Vertical Axis"
End With
'change orientation of Category Axis text
With .Axes(xlCategory).TickLabels
Alignment = xlCenter
Offset = 100
Orientation = xlHorizontal
End With
HasLegend = True
Legend.Position = xlBottom
'Location Where:=xlLocationAsObject, Name:="ChartData"
End With
'move chart around
ActiveSheet.Shapes("Chart 1").IncrementLeft 10
ActiveSheet.Shapes("Chart 1").IncrementTop -90
End With
'do some text alignment and formatting
With .Range("A2:B22")
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
End With
Range("A1:B2").Font.Bold = True
Range("A:B").EntireColumn.AutoFit
'Pagesetup stuff
With .PageSetup
LeftFooter = "Created &T &D"
CenterFooter = "&P of &N"
LeftMargin = xLApp.InchesToPoints(0.42)
RightMargin = xLApp.InchesToPoints(0.47)
TopMargin = xLApp.InchesToPoints(0.52)
BottomMargin = xLApp.InchesToPoints(0.55)
HeaderMargin = xLApp.InchesToPoints(0.5)
FooterMargin = xLApp.InchesToPoints(0.35)
PrintTitleRows = "$1:$2"
PrintComments = xlPrintNoComments
PrintQuality = 600
Orientation = xlLandscape
PaperSize = xlPaperA4
FirstPageNumber = xlAutomatic
Order = xlDownThenOver
End With
'format borders
'With .Range("A2:B22")
'For iBorder = 7 To 11
' Borders(iBorder).LineStyle = xlContinuous
'Next
' Borders(xlInsideHorizontal).LineStyle = xlDot
'End With
'With .Range("A2:B2")
'For iBorder = 7 To 10
' Borders(iBorder).LineStyle = xlContinuous
'Next
'End With
Range("A1").Select
End With
'Save File
wb.SaveAs sPath & sFile & " " & sDate & ".xls"
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case 3021
Case Else
MsgBox "Problem with CreateXLChart()" & vbCrLf _
& "Error " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
'if no records then clean up excel
vSysCmd = SysCmd(acSysCmdClearStatus)
If iRecordCount = 0 Then
wb.Close SaveChanges:=False
xLApp.Quit
End If
'clean up objects
Set wb = Nothing
Set xLApp = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

 

[Guest]

It might be that you have 'ORDER BY ID' in your SQL statement, but you have
not included the ID field in your SELECT.

HTH,
Clint

 

[Guest]

It might be that you have 'ORDER BY ID' in your SQL statement, but you have
not included the ID field in your SELECT.

HTH,
Clint

 

[Tim Ferguson]

I used the code that was posted on here, but i am receiving an error.
"Error 3021: Too few parameters. Expected 1."

This is practically always caused by a misspelled field name in a query.
You don't indicate which of your hundred lines or so caused the error, and
I don't have the time to read it carefully, but I guess it might be here:

sSQL = "SELECT DataSeries1, DataSeries2 " _
& "FROM Table1 " _
& "ORDER BY ID;"
'Debug.Print sSQL
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

There are three fields mentioned: DataSeries1, DataSeries2, and ID (which
strike me as pretty lame names, but what do I know?) so I should check very
carefully the first two for embedded spaces and the like. For example
[DataSeries 1] or [Data Series 1] etc etc etc.

Best of luck

Tim F

 

[Ed Adamthwaite]

Hi all,
the code is a sample I posted for cherman quite some time ago.
I omitted to include the autonumber "ID" field with the instructions:

Sorry about that folks. The Fieldnames are "lame" as they were named that
for instructional purposes only.
It is a sample with a fiew bells and whistles added.
For instance, the sSysMsg variable is the text string to go with a progress
meter displaying in the access status bar. You will see this if you comment
the " xLApp.Visible = True" line. Some people like to see Excel being
manipulated, some don't. If you place it after the Excel file is saved,
you'll see the progress meter, and only see the Excel file after the
manipulation has finished.

The easiest way to learn how to manipulate Excel is to record a macro in
Excel and then copy the code to your procedure in Access. You'll have to
make sure that you change the object dependancies.
"Selection" becomes "XlApp.Selection" etc
Have fun with it. The VB is fairly readable and the Excel stuff should make
sense.

Ed.