Generate Pie Chart in Excel

[Question Boy]

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

 

[Ed Adamthwaite]

Hi QB,
usually the "server not available" error is caused by not an object or
method not properly set in the object heirarchy.
For example:
Dim xlApp as Excel.Applictation
Dim wb As Excel..WorkSheet
Set xlApp = New Excel.Applictation
Set wb = xlApp.Workbooks.Add()

With wb.Worksheets(1)
.Cells(1,1) = "Fred" 'IS WRONG....
End With

Because .Cells() either part of the xlApp object or a Range object, not part
of a workbook or worksheet.
In my experience the sample works because somehow behind the scenes
sometimes it figures out what you are trying to do,but other times spits out
your error.

So look for something wrong with your object heirarchy, checking in the
Object Browser that the objects or methods are actually part of the object
that they are hung off in yor code.

Regards,
Ed.

 

[Ed Adamthwaite]

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.