Avatar of mss72

asked on 

Excel 2007 VBA very slow to add shapes to a chart

I am programmimg charts in Excel 2007 and find that to add a graphical legend using shapes is very slow whereas in Excel 2003 it is fast. Why is this?
Microsoft Excel

Avatar of undefined
Last Comment
Ingeborg Hawighorst (Microsoft MVP / EE MVE)
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

The chart engine in 2007 is completely different to in previous versions, but without seeing the code it is hard to be specific.
Avatar of mss72


The code I am using works very fast in Excel 2003 but is very slow in 2007
'This routine makes the panel legend using the data provided in 'vaCurItemColours' and 'vaData'
'the flag 'bTopBottom' determines the legend position
''bLegend' determins if a legend is to be created or deleted
''bShort' determines if the legend contains all the items in the DB or only those in the current data
Public Sub MakePanelLegend(Cht As Chart, bFillClear As Boolean, bTopBottom As Boolean, bLegend As Boolean, vaCurItemColours() As Variant, vaData() As Variant, bShort As Boolean)
On Error GoTo Err_MakePanelLegend

    Dim shItem As Shape, stName As String
    If Cht.Shapes.Count > 0 Then
        For Each shItem In Cht.Shapes
        Next shItem
    End If
    If bFillClear = False Then Cht.PlotArea.top = 58: Cht.PlotArea.Height = 486: Exit Sub
    If bLegend = False Then Cht.PlotArea.top = 58: Cht.PlotArea.Height = 486: Exit Sub
    If ArrayEmpty(vaData) Then Exit Sub
    If rsData Is Nothing Then Exit Sub
    Dim vaUsedItemColours() As Variant
    If bShort Then
        vaUsedItemColours = GetUsedItemColours(vaData, vaCurItemColours)
        vaUsedItemColours = vaCurItemColours
    End If
    Dim sgTop As Single, sgLeft As Single, i As Integer
    Application.ScreenUpdating = False
    ActiveSheet.ChartObjects("Chart 14").Activate
    With Cht
        .PlotArea.Height = 426
        If bTopBottom Then
            .PlotArea.top = 118
            sgTop = .PlotArea.top - 30
            .PlotArea.top = 58
            sgTop = .PlotArea.InsideTop + .PlotArea.Height
        End If
        sgLeft = .PlotArea.InsideLeft
        For i = LBound(vaUsedItemColours) To UBound(vaUsedItemColours)
            .Shapes.AddShape(msoShapeRectangle, sgLeft + (i Mod 12) * 60, sgTop + (i \ 12) * 15, 10, 10).Select
            Selection.ShapeRange.Line.Visible = msoTrue
            Selection.ShapeRange.Line.Weight = 0.1
            Selection.ShapeRange.Fill.Visible = msoTrue
            Selection.ShapeRange.Fill.ForeColor.RGB = vaUsedItemColours(i, 2)
            Selection.ShapeRange.Fill.Transparency = 0#
            .Shapes.AddLabel(msoTextOrientationHorizontal, sgLeft + (i Mod 12) * 60 + 10, sgTop + (i \ 12) * 15, 30, 10).Select
            Selection.ShapeRange(1).TextFrame.AutoSize = msoTrue
            If CStr(vaUsedItemColours(i, 0)) <> "" Then
                Selection.Text = CStr(vaUsedItemColours(i, 0))
                Selection.Text = "Blank"
            End If
            With Selection.Font
                .Name = "Arial"
                .Size = 10
                .FontStyle = "Normal"
            End With
            If Selection.ShapeRange(1).Width > 48 Then Selection.Font.Size = 8
        Next i
    End With
    Application.ScreenUpdating = True

    Exit Sub
    MsgBox "MakePanelLegend " & Err.Description
    Resume Exit_MakePanelLegend

End Sub

Open in new window

That doesn't really mean a lot to me on its own as you call various other routines and I don't know what rsData is or what this bit is for:
    ActiveSheet.ChartObjects("Chart 14").Activate

Open in new window

Is this a 2003 format workbook, or a 2007 one?
Avatar of mss72


My apologies for the lack of sufficient information. The array 'vaCurItemColours' contains colour and textual information, provided from a user-defined colour scheme, for the legend which is of the form; coloured square followed by an item name. The array 'vaData' contains information about which bit of the chart data contains which item for the legend so that only relevant items appear in the legend if 'bShort' is true. All the data comes from an ACCESS database.

The code snippet you were puzzled about gets a second reference to the chart, 'Cht' being the first. For some reason the part of the routine in the for loop does not work with 'Cht' as the reference!

The only part of the routine that is slow in 2007 is the part within the for loop which generates the legend graphics.

Hope this helps
And what is rsData (not declared anywhere that I can see) and is this a workbook created in 2007, or a 2003 format, or a workbook converted from 2003 format?
Avatar of mss72


'rsData' is a global RecordSet object containing all the current data to be plotted. 'rsData' is a cloned object embedded in a 'Stream' object to free it from the ACCESS database from which it was filled by a user-generated SQL statement. It is referenced in this routine simply to ensure that there is live data present.

The Workbook was originally a 2003 Workbook now opened in 2007 but not converted to 2007 format so that it can be used in either 2003 or 2007 once library references have been adjusted.
As I mentioned at the start, I suspect it is purely down to the new charting and shapes engine in 2007, especially as you are using an older format workbook. (2007 code is generally slower than 2003 anyway in my experience).
Avatar of mss72

Blurred text
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
Microsoft Excel
Microsoft Excel

Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.

Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews


IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo