I have data in a MSAccess table that I want to graph in Excel. All the data will be displayed in one page in Excel however each row will have it's own chart within the same workbook. The following code works great on the first row but gives me the dreaded 1004 error the second time through the graph creation do until loop. Help
Private Sub Command4_Click()
On Error GoTo cmdCreateGraph_Err
Dim db As Database
Dim rst As Recordset
Dim fld As Field
Dim objWS As Object
Dim intRowCount As Integer
Dim intColCount As Integer
Dim gobjExcel As Excel.Application
Dim rstCount As Recordset
Dim intCountRow As Integer
Dim recCount As Integer
Dim rstOrgns As Recordset
Dim strSQLOrgns As String
Dim fld1 As Field
'Display Hourglas
DoCmd.Hourglass True
Set db = CurrentDb
Set gobjExcel = New Excel.Application
'Attempt to create recordset and launch excel
If CreateRecordset(db, rst, "qry6_Year_Graphs") Then
gobjExcel.Visible = True
gobjExcel.Workbooks.Add
Set objWS = gobjExcel.ActiveSheet
intRowCount = 1
intColCount = 1
For Each fld In rst.Fields
If fld.Type <> dbLongBinary Then
objWS.Cells(1, intColCount).Value = fld.Name
intColCount = intColCount + 1
End If
Next fld
Do Until rst.EOF
intColCount = 1
intRowCount = intRowCount + 1
For Each fld In rst.Fields
If fld.Type <> dbLongBinary Then
objWS.Cells(intRowCount, intColCount).Value = fld.Value
intColCount = intColCount + 1
End If
Next fld
rst.MoveNext
Loop
gobjExcel.Columns("A:H").Select
gobjExcel.Columns("A:H").EntireColumn.AutoFit
gobjExcel.Range("A1").Select
' Graph Creation
Set rstCount = db.OpenRecordset("Select Count(*) as NumRecords from qry6_Year_Graphs")
MsgBox "The Number of Records is " & rstCount!NumRecords, vbOKOnly
recCount = rstCount!NumRecords + 1
MsgBox "Now Num of Records is " & recCount, vbOKOnly
strSQLOrgns = "Select ORGN_CODE_KEY, FTVORGN_TITLE " & _
"FROM 6_Year_Costs_Final;"
Set rstOrgns = db.OpenRecordset(strSQLOrgns)
intCountRow = 2
Do Until intCountRow >= recCount
gobjExcel.Range("C" & intCountRow, "H" & intCountRow).Select
MsgBox "Range Set in Excel", vbOKOnly
gobjExcel.Charts.Add
MsgBox "Chart Added", vbOKOnly
gobjExcel.Charts.Select
gobjExcel.ActiveChart.ChartType = xlColumnClustered
With gobjExcel.ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Organizational Net Revenue by Year for " & rstOrgns!FTVORGN_TITLE
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Fiscal Year"
.Axes(xlCategory, xlPrimary).MajorTickMark = xlOutside
.Axes(xlCategory, xlPrimary).TickLabelPosition = xlLow
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Cost Per Year"
.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "#,##0"
.HasLegend = False
'.Legend.Position = xlLegendPositionRight
.Name = rstOrgns!ORGN_CODE_KEY
.SeriesCollection(1).XValues = "=Sheet1!R1C3:R1C8"
End With
MsgBox "Ended Chart Formatting", vbOKOnly
intCountRow = intCountRow + 1
MsgBox "intCountRow is now " & intCountRow, vbOKOnly
Loop
Else
MsgBox "Too Many Records to Send to Excel"
End If
DoCmd.Hourglass False
cmdCreateGraph_Exit:
Set db = Nothing
Set rst = Nothing
Set fld = Nothing
Set objWS = Nothing
DoCmd.Hourglass False
Exit Sub
cmdCreateGraph_Err:
MsgBox "Error # (Sub) " & Err.Number & ": " & Err.Description
Resume cmdCreateGraph_Exit
End Sub
Public Function CreateRecordset(dbAny As Database, rstAny As Recordset, _
strTableName As String)
Dim rstCount As Recordset
On Error GoTo CreateRecordset_Err
Set rstCount = dbAny.OpenRecordset("Select Count(*) As NumRecords from " & strTableName)
If rstCount!NumRecords > 500 Then
CreateRecordset = False
Else
Set rstAny = dbAny.OpenRecordset(strTableName, dbOpenDynaset)
CreateRecordset = True
End If
CreateRecordset_Exit:
Set rstCount = Nothing
Exit Function
CreateRecordset_Err:
MsgBox "Error (Recordset) # " & Err.Number & ": " & Err.Description
Resume CreateRecordset_Exit
End Function