Computing.Net > Forums > Programming > VB Code To create multiple Graphs i

Computing.Net: Over 1,000,000 posts about all things technology related! Over 90% answered within 24 hours! Click here to sign up now, it's free!

VB Code To create multiple Graphs i

Reply to Message Icon

Original Message
Name: Rich
Date: September 17, 2003 at 08:08:13 Pacific
Subject: VB Code To create multiple Graphs i
OS: Windows 2000
CPU/Ram: Dell GX300 256mb?
Comment:

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



Report Offensive Message For Removal








Post Locked

This post is quite old and has been locked from receiving new replies. Please create a new posting instead.


Go to Programming Forum Home








Do you have your own blog?

Yes
No
I did before
I will soon


View Results

Poll Finishes In 4 Days.
Discuss in The Lounge
Poll History




Data Recovery Software