Chart Edition by access VBA very Slow - ms-access

Question

I use a Chart to Display Progress of Activity on ms-access 2007 with VBA, I used to work with PivotCharts wich was fast but not really editable. I need to only display the past months and make invisibles points for the rest of the year.
My Chart is display with 2 Series of 300 points (granularity increased), but I only show Data Labels once in a month.
I wasn't able to edit point by point with Pivot Chart so I moved to a classic oldStyle Chart.
My problem is that my edit is very slow, I've read about many things about VBA optimization but nothing done the trick
I measured 20 seconds for each curve it's not "acceptable" for my hierarchy.
I was thinking about multi-threading but it's way too much work for a so small benefit (%4? or %8?)
(FYI Calculation of points and so on is done before the opening of the Form and is doing great)
Here is my code of this Slow Chart Edition :
Dim intPntCount As Integer
Dim intTmp As Integer
Dim oSeries As Object
Dim colSeries As SeriesCollection
Dim oPnt As Object
Dim intCptSeries As Byte
Dim booPreviousZero As Boolean
Dim startDate, endDate As Date
Dim lngWhite, LngBlack As Long
lngWhite = RGB(255, 255, 255)
LngBlack = RGB(0, 0, 0)
linPlanned.BorderColor = RGB(251, 140, 60)
linCompleted.BorderColor = RGB(52, 84, 136)
lblUnit.Left = 1248 'use fctgetabsciisa chProgressFixs.Axes(2).MaximumScale / 80
With Me.chProgressFixs
startDate = Now
.BackColor = lngWhite
intCptSeries = 0
'colSeries = .SeriesCollection
For Each oSeries In .SeriesCollection
intCptSeries = intCptSeries + 1
Debug.Print "Series" & intCptSeries
booPreviousZero = True
intPntCount = 1
For Each oPnt In oSeries.Points
oPnt.ApplyDataLabels
If oPnt.DataLabel.Caption = "0" Then
oPnt.Border.Weight = 1
oPnt.DataLabel.Caption = vbNullString
If booPreviousZero = False Then
oPnt.Border.Color = lngWhite
booPreviousZero = True
Else
oPnt.Border.Color = LngBlack
End If
Else
booPreviousZero = False
oPnt.Border.Weight = 4
oPnt.DataLabel.Font.Size = 14
Select Case intCptSeries
Case 1: oPnt.Border.Color = linPlanned.BorderColor
Case 2: oPnt.Border.Color = linCompleted.BorderColor
End Select
If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
If (intPntCount < oSeries.Points.Count) Then
If (intPntCount <> IntLastDispDay - 1) Then
oPnt.DataLabel.Caption = vbNullString
Else
oPnt.DataLabel.Font.Size = 20
End If
End If
End If
End If
intPntCount = intPntCount + 1
Next
Debug.Print DateDiff("s", startDate, Now)
Next
Me.TimerInterval = 1
End With
Thanks all for your help

Answer 1

Maybe you need to avoid screen refresh with:
Application.ScreenUpdating = False
and then
Application.ScreenUpdating = true
when finished. It also be helpful if you use \ insted of / when dividing, if you don't care about working only with integers. Try it.

Answer 2

Maybe you should replace:
If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
with something like
If (((intPntCount + 30) MOD 30) > 0 ) Then
and measure the time of execution. Another thing about your code is that:
oPnt.DataLabel.Font.Size = 14
...maybe should be inside the if's trying to avoid rewrite the property two times. Try something like:
If (((intPntCount + 30) MOD 30) > 0 ) Then
If (intPntCount < oSeries.Points.Count) Then
If (intPntCount <> IntLastDispDay - 1) Then
oPnt.DataLabel.Caption = vbNullString
oPnt.DataLabel.Font.Size = 14
Else
oPnt.DataLabel.Font.Size = 20
End If
Else
oPnt.DataLabel.Font.Size = 14
End If
Else
oPnt.DataLabel.Font.Size = 14
End If
Even it would be a very very little improvement to precalculate
(intPntCount + 30)
in a variable after
intPntCount = intPntCount + 1
...and use something like:
dim intPntCountSum= 0
(...)
End If
intPntCount = intPntCount + 1
intPntCountSum=intPntCount + 30
Next
Finally, if you don't need the debug info, it would be a good thing to delete the lines:
Debug.Print "Series" & intCptSeries
and
Debug.Print DateDiff("s", startDate, Now)
I hope it help.