Hi RD,
What follows is an example of how to create and manipulate a chart in Excel
from Access.
First, create a table called "Table1" with the fieldnames "DataSeries1" and
"DataSeries2" and a data type Long.
fill it with data as below:
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
Then paste the code below into a standard module (fix any line wrap errors
created by your news reader), set a reference to Excel under
Tools|Refererences in the VBA IDE and run it.
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
xLApp.Charts.Add
With xLApp
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 = "Access SIG's Straight & Wobbly Stuff"
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.AxisTitle.Characters.Text = "Access SIG's Horizontal Axis"
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Characters.Text = "Access SIG'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 -40.5
.ActiveSheet.Shapes("Chart 1").IncrementTop -88.5
' msoFalse, msoScaleFromTopLeft require a reference to the MS Office
Library
.ActiveSheet.Shapes("Chart 1").ScaleWidth 1.12, msoFalse,
msoScaleFromTopLeft
.ActiveSheet.Shapes("Chart 1").ScaleHeight 1.36, msoFalse,
msoScaleFromTopLeft
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
'note the use of numbers instead of XlBordersIndex enum constants
With .Range("A2:B22")
'instead of using...
' .Borders(xlEdgeLeft).LineStyle = xlContinuous
' .Borders(xlEdgeTop).LineStyle = xlContinuous
' .Borders(xlEdgeBottom).LineStyle = xlContinuous
' .Borders(xlEdgeRight).LineStyle = xlContinuous
' .Borders(xlInsideVertical).LineStyle = xlContinuous
'Use...
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
If you want an example of how to do a pie chart, create a macro in Excel and
then copy the code into Access, but make sure to change the object hierarchy
of the code to work with "xLApp".
I hope this helps,
Regards,
Ed.
