我用一个图表中显示的MS-Access 2007中使用VBA活动的进展情况，我使用数据透视图至极的工作非常快，但没有真正编辑。我只需要显示过去几个月，使无形点，为今年余下时间。

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.

我的图表显示，2系列的300点（粒度增大），但我只在一个月内显示数据标签一次。 我是不是能够通过点与透视图表编辑点，所以我搬到了一个典型的旧式图表。

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.

我的问题是，我的编辑是很慢的，我已经知道了有关VBA的优化，但没有很多东西做的伎俩 我测20秒每一条曲线它不是可以接受我的层次结构。 我在想的多线程，但它是一个非常小的好处太多的工作（％4？还是8％？）

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)

下面是我的$ C $这种缓慢图版C：

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

推荐答案

也许你应该替换：

If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then

喜欢的东西

If (((intPntCount + 30) MOD 30) > 0 ) Then

和测量的执行时间。关于你的code的另一件事是：

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

即使这将是一个非常非常小的改进，以precalculate

Even it would be a very very little improvement to precalculate

 (intPntCount + 30)

在一个变量之后

 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

和

Debug.Print DateDiff("s", startDate, Now)

我希望这有助于。

I hope it help.