Hi again QB,
Create a table called "Table1" with 3 fields,
ID Primary Key AutoNumber
DataSeries1 Long
DataSeries2 Long
ID DataSeries1 DataSeries2
1 1 5
2 2 25
3 3 9
4 4 8
5 5 3
6 6 2
7 7 5
8 8 9
9 9 11
10 10 6
11 11 4
12 12 5
13 13 6
14 14 7
15 15 8
16 16 9
17 17 10
18 18 11
19 19 13
20 20 15
Use the following code in a standard module. Watch out for line wraps with
your News Reader.
There are a few refinements, showing a progress bar in the Status bar and
some extra code commented out because it doesn't apply to pie charts.
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 = xlPie '<<<<<<======================
.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"
'Following code commented because of pie chart, uncomment if line chart
' 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
I hope this helps,
regards,
Ed.
"Question Boy" <(E-Mail Removed)> wrote in message
news:39884FEE-FBCD-49E9-9715-(E-Mail Removed)...
>I am trying to generate chart in excel from data from a query.
>
> I looked at
> http://c85.cemi.rssi.ru/access/Books/ABA/aba25fi.htm
>
> Specifically Creating a Graph from Access
>
> but it works the first time and then keep spitting out errors about server
> not available... (there is no servers even involved in this process!)...
> I've been fighting with it for several hours. Would someone have a
> 'simple'
> sample code to generate pie charts that I could start from that works
> properly.
>
> Thank you,
>
> QB
Similar Threads
