Creating Charts in Excel from Access.

[Ian Mac]

All,

I have been banging my head against a brick wall over this,
I sometimes get given Access VBA code to look at when other get a little stuck.

I'm by no means an expert, the reason is that the code they usually find problems with is manipulating Excel objects and that where I come.

BUT, I have of been give a few files that are trying to add charts to an existing template and have experianced the same problem over and over.

All the files can pass the data to a worksheet BUT when I/they/we try to set the SourceData of th Chart good old runtime 1004 pops up to ruin the day,
here an example of the line concerned;

.SetSourceData Source:=Sheets("Progress Report").Range(myRange), _
PlotBy:=xlColumns

this doesn't happen all the time but at least 1 in 20 times.

Does anyone have any experiance of this, any work arounds.
The annoying thing is that I know the code is good, I can run it from within Excel, replacing the myRange with a set range.

Here's the whole code incase it something else triggering it:

Private Sub PerformanceAnalysis()

Dim Weeks As Double, Remainder As Boolean, i As Integer, rstemp As Recordset, StartDate, StopDate As Date, arrPerf(), qdquery As QueryDef
Dim sql, ByTM, ByAccount, CallType, ByCSP, ChartTitle As String, Monitored As Integer

Set qdquery = CurrentDb.QueryDefs("qryProgressByAccount")

sql = "SELECT Avg(Main.BodyPer) AS AvgOfBodyPer, Avg(Main.SummarisingPer) AS AvgOfSummarisingPer, Avg(Main.TechnicalPer) AS AvgOfTechnicalPer, Avg(Main.OpeningPer) AS AvgOfOpeningPer, Avg(Main.OverallPer) AS AvgOfOverallPer FROM Main WHERE (((Main.CallDate) Between GetBeginDate() And GetEndDate())"
ByAccount = " AND ((Main.Account)=GetAccount()))"
ByTM = " AND ((Main.TeamManager)=GetTM())"
ByCSP = " AND ((Main.CSP)=GetCSP())"
ChartTitle = ""
If Not IsNull(Me.cmbCSP) Then
sql = sql & ByCSP
z_CSPName = Me.cmbCSP
ChartTitle = z_CSPName
End If

If Not IsNull(Me.cmbAccount) Then
sql = sql & ByAccount
z_Account = Me.cmbAccount
If ChartTitle <> "" Then
ChartTitle = ChartTitle & ", " & z_Account
Else
ChartTitle = z_Account
End If
End If

If Me.chkQA = True Then
If Me.chkTM = True Then
Monitored = 0
Else
Monitored = 1
CallType = " AND ((Right([CallCoach],4))=" & Chr(34) & "(QA)" & Chr(34) & ")"
End If
Else
If Me.chkTM = True Then
Monitored = 2
CallType = " AND ((Right([CallCoach],4))<>" & Chr(34) & "(QA)" & Chr(34) & ")"
End If
End If

If Monitored > 0 Then
qdquery.sql = (sql & CallType)
Else
qdquery.sql = (sql)
End If

If Not IsNull(Me.cmbTM) Then
qdquery.sql = qdquery.sql & ByTM
z_TM = Me.cmbTM
ChartTitle = ChartTitle & ", (" & z_TM & "'s team)"
End If

qdquery.Close

z_BeginDate = Me.txtBeginDate
z_EndDate = DateAdd("d", 1, Me.txtEndDate)
StopDate = z_EndDate
StartDate = z_BeginDate

ChartTitle = ChartTitle & " Analysis, " & StartDate & " - " & DateAdd("d", -1, StopDate)

If Me.chkQA = True And Me.chkTM = True Then
ChartTitle = ChartTitle & " , (QA & TM Calls)"
Else
If Me.chkQA = True Then
ChartTitle = ChartTitle & " , (QA Calls only)"
Else
ChartTitle = ChartTitle & " , (TM Calls only)"
End If
End If

Weeks = (z_EndDate - z_BeginDate) / 7

If Len(Trim((Str$(Weeks)))) > 1 Then
Weeks = Int(Weeks)
Remainder = True
Else
Remainder = False
End If

z_EndDate = DateAdd("d", 7, z_BeginDate)
For i = 1 To Weeks
Set rstemp = CurrentDb.OpenRecordset("qryProgressByAccount")
If Not rstemp.EOF Then
ReDim Preserve arrPerf(6, Weeks)
rstemp.MoveFirst
arrPerf(0, i - 1) = Str$(z_BeginDate) & " - " & Str$(DateAdd("d", -1, z_EndDate))
arrPerf(1, i - 1) = rstemp!AvgOfOpeningPer
arrPerf(2, i - 1) = rstemp!AvgOfBodyPer
arrPerf(3, i - 1) = rstemp!AvgOfSummarisingPer
arrPerf(4, i - 1) = rstemp!AvgOfTechnicalPer
arrPerf(5, i - 1) = rstemp!AvgOfOverallPer
rstemp.MoveNext
z_BeginDate = DateAdd("d", 7, z_BeginDate)
z_EndDate = DateAdd("d", 7, z_EndDate)
End If
Next

If Remainder = True Then
z_EndDate = StopDate
If z_BeginDate < z_EndDate Then
Set rstemp = CurrentDb.OpenRecordset("qryProgressByAccount")
If Not rstemp.EOF Then
ReDim Preserve arrPerf(6, Weeks + 1)
arrPerf(0, i - 1) = Str$(z_BeginDate) & " - " & Str$(DateAdd("d", -1, z_EndDate))
arrPerf(1, i - 1) = rstemp!AvgOfOpeningPer
arrPerf(2, i - 1) = rstemp!AvgOfBodyPer
arrPerf(3, i - 1) = rstemp!AvgOfSummarisingPer
arrPerf(4, i - 1) = rstemp!AvgOfTechnicalPer
arrPerf(5, i - 1) = rstemp!AvgOfOverallPer
rstemp.MoveFirst
End If
End If
End If
rstemp.Close

Dim xlapp, xlBook, xlSheet As Object
Dim MFILE As String

Set xlapp = CreateObject("Excel.Application")
Set xlBook = xlapp.Workbooks.Add("\\gbnewdials01\quality$\download\ProgressReport.xlt ")
Set xlSheet = xlBook.Worksheets(1)

xlapp.Visible = True
xlapp.Application.Sheets("Progress Report").cells(2, "A") = "Account : " & z_Account
xlapp.Application.Sheets("Progress Report").cells(3, "A") = "Date Period : " & Form_frmReports.txtBeginDate & " to " & Form_frmReports.txtEndDate
Dim h As Integer, v As Integer
For v = 7 To ((IIf(Remainder = True, Weeks + 1, Weeks)) + 7)
For h = 0 To 5
xlapp.Application.Sheets("Progress Report").cells(v, Chr$(h + 65)) = arrPerf(h, v - 7)
Next
Next

Dim myRange As String, n As Integer
myRange = "A6:F"
myRange = myRange & Trim(Str$(IIf(Remainder = True, (7 + Weeks), (6 + Weeks))))
xlapp.Application.Charts.Add
With xlapp.Application.Charts(1)
.ChartType = xlLineMarkers
.Location Where:=xlLocationAsNewSheet, Name:="Graph"
End With


xlapp.Application.Sheets("Graph").Activate
With xlapp.Application.Charts(1)
.SetSourceData Source:=Sheets("Progress Report").Range(myRange), _
PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Characters.Text = ChartTitle
.Axes(xlValue, xlPrimary).HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False

For n = 5 To 1 Step -1
If n = 5 Then
.SeriesCollection.Border.Weight = xlThick
End If
.SeriesCollection.Smooth = True

.Axes(xlCategory).TickLabels.Orientation = 45
Next

.SeriesCollection(4).Border.ColorIndex = 5
.SeriesCollection(4).MarkerForegroundColorIndex = 5

End With

End Sub

This really has got me stumped, so if anyone can help I'd be the most Greatfullest person ever.