Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code very slow
I am labelling points on a scatter graph with boat names. There are 68
points on the graph and it takes over 90 seconds to run this routine. The computer is a fast dual core machine Any ideas why tis proceedure is so slow. The recordsource for the graph is SELECT QSpaceAllocation.XPos, QSpaceAllocation.YPos, QSpaceAllocation.SpaceAndName, QSpaceAllocation.StdLabPosLeft, QSpaceAllocation.StdXLabOffset, QSpaceAllocation.StdLabPosUp, QSpaceAllocation.StdYLabOffset, QSpaceAllocation.StdLabOrientation, QSpaceAllocation.XLabelPosition, QSpaceAllocation.YLabelPosition, QSpaceAllocation.LabelAngle FROM QSpaceAllocation ORDER BY QSpaceAllocation.XPos, QSpaceAllocation.YPos, QSpaceAllocation.SpaceAndName; The XPos and YPos are the positions of the points: The SpaceAndName is the label.Caption: Anything begining with Std is to do with positioning all the labels on the graph relative to the XY position. Other fields are for over-riding the standard position and orientation. I have half written the code to "Jiggle" the labels but as this is running so slowly, I am reluctant to proceed. Thanks Phil ' Label points with Standard offsets and angles Function LabelIt() As Boolean Dim Cht As Graph.Chart Dim ChtSeries As Series Dim ChtLabel As DataLabel Dim ChtArea As ChartArea Dim DataSht As DataSheet Dim pntDataPoint As Point Dim OrderPos As Integer Dim lCount As Long Dim DirectionUp As String Dim IncrementUp As Long Dim DirectionLeft As String Dim IncrementLeft As Long Dim Orientation As Integer Dim LblYOffset As Long, LblXOffset As Long Dim MyDb As Database Dim SpaceAllocationSet As Recordset Dim SQLStg As String, Stg As String Dim NoPoints As Integer Dim LngRtn As Long Const szSOURCE As String = "LabelIt()" Set MyDb = CurrentDb AllocationPlan.Refresh DoEvents Set Cht = Me.AllocationPlan.Object Set DataSht = Cht.Application.DataSheet 'ChartHeight = Cht.Height 'ChartWidth = Cht.Width Stg = Me.AllocationPlan.RowSource Stg = Left(Stg, Len(Stg) - 1) ' Remove last ; OrderPos = InStr(Stg, "ORDER BY") SQLStg = Left(Stg, OrderPos - 1) & "WHERE SpaceTypeID = " & SpaceTypeID SQLStg = SQLStg & " " & Mid(Stg, OrderPos) & ";" Set SpaceAllocationSet = MyDb.OpenRecordset(SQLStg) Set ChtSeries = Cht.SeriesCollection(1) Cht.HasDataTable = True Cht.ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False With SpaceAllocationSet .MoveLast NoPoints = .RecordCount .MoveFirst ' Get info all the same of each SpaceTypeID 'LblAngle = !LabelAngle DirectionUp = !StdLabPosUp DirectionLeft = !StdLabPosLeft LblXOffset = !StdXLabOffset LblYOffset = !StdYLabOffset Orientation = !StdLabOrientation LngRtn = SysCmd(acSysCmdInitMeter, "Labeling " & NoPoints & " points", NoPoints) ChtSeries.MarkerStyle = xlMarkerStyleX ChtSeries.MarkerSize = 4 ChtSeries.MarkerForegroundColorIndex = 3 ' Red ChtSeries.MarkerBackgroundColorIndex = xlColorIndexNone ' Enable Data Labels in the chart 'Loop through each data label and set its 'Top, Left, and Font properties For lCount = 1 To ChtSeries.Points.Count Set pntDataPoint = ChtSeries.Points(lCount) Err.Clear If pntDataPoint.HasDataLabel = True Then ' Add the data label and position it if necessary. Set ChtLabel = pntDataPoint.DataLabel ChtLabel.Position = xlLabelPositionCenter ChtLabel.Caption = !SpaceAndName Select Case DirectionUp Case "U" ' Up ChtLabel.Top = ChtLabel.Top - IncrementUp Case "D" ' Down ChtLabel.Top = ChtLabel.Top + IncrementUp Case Else MsgBox "Unrecognised Vertical Direction", vbCritical Exit Function End Select Select Case DirectionLeft Case "L" ' Left ChtLabel.Left = ChtLabel.Left - IncrementLeft Case "R" ' Right ChtLabel.Left = ChtLabel.Left + IncrementLeft Case Else MsgBox "Unrecognised Horizontal Direction", vbCritical Exit Function End Select ' Set angle ChtLabel.Orientation = Orientation ChtLabel.Font.Color = RGB(0, 0, 0) ' Black ChtLabel.Font.Size = 7 ChtLabel.Font.Name = "Arial" ChtLabel.Font.Bold = False .MoveNext LngRtn = SysCmd(acSysCmdUpdateMeter, lCount) End If Next .Close Set SpaceAllocationSet = Nothing End With AllocationPlan_Exit: LngRtn = SysCmd(acSysCmdRemoveMeter) LabelIt = True Exit Function AllocationPlan_Err: If Err.Number < glHANDLED_ERROR Then Err.Description = Err.Description & " (" & szSOURCE & ")" If bCentralErrorHandler(False) Then Stop Resume Next Else Resume AllocationPlan_Exit End If End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code very slow
Have you tried turning off screenupdating while the plot is being updated ?
Tim "Phil Stanton" wrote in message ... I am labelling points on a scatter graph with boat names. There are 68 points on the graph and it takes over 90 seconds to run this routine. The computer is a fast dual core machine Any ideas why tis proceedure is so slow. The recordsource for the graph is SELECT QSpaceAllocation.XPos, QSpaceAllocation.YPos, QSpaceAllocation.SpaceAndName, QSpaceAllocation.StdLabPosLeft, QSpaceAllocation.StdXLabOffset, QSpaceAllocation.StdLabPosUp, QSpaceAllocation.StdYLabOffset, QSpaceAllocation.StdLabOrientation, QSpaceAllocation.XLabelPosition, QSpaceAllocation.YLabelPosition, QSpaceAllocation.LabelAngle FROM QSpaceAllocation ORDER BY QSpaceAllocation.XPos, QSpaceAllocation.YPos, QSpaceAllocation.SpaceAndName; The XPos and YPos are the positions of the points: The SpaceAndName is the label.Caption: Anything begining with Std is to do with positioning all the labels on the graph relative to the XY position. Other fields are for over-riding the standard position and orientation. I have half written the code to "Jiggle" the labels but as this is running so slowly, I am reluctant to proceed. Thanks Phil ' Label points with Standard offsets and angles Function LabelIt() As Boolean Dim Cht As Graph.Chart Dim ChtSeries As Series Dim ChtLabel As DataLabel Dim ChtArea As ChartArea Dim DataSht As DataSheet Dim pntDataPoint As Point Dim OrderPos As Integer Dim lCount As Long Dim DirectionUp As String Dim IncrementUp As Long Dim DirectionLeft As String Dim IncrementLeft As Long Dim Orientation As Integer Dim LblYOffset As Long, LblXOffset As Long Dim MyDb As Database Dim SpaceAllocationSet As Recordset Dim SQLStg As String, Stg As String Dim NoPoints As Integer Dim LngRtn As Long Const szSOURCE As String = "LabelIt()" Set MyDb = CurrentDb AllocationPlan.Refresh DoEvents Set Cht = Me.AllocationPlan.Object Set DataSht = Cht.Application.DataSheet 'ChartHeight = Cht.Height 'ChartWidth = Cht.Width Stg = Me.AllocationPlan.RowSource Stg = Left(Stg, Len(Stg) - 1) ' Remove last ; OrderPos = InStr(Stg, "ORDER BY") SQLStg = Left(Stg, OrderPos - 1) & "WHERE SpaceTypeID = " & SpaceTypeID SQLStg = SQLStg & " " & Mid(Stg, OrderPos) & ";" Set SpaceAllocationSet = MyDb.OpenRecordset(SQLStg) Set ChtSeries = Cht.SeriesCollection(1) Cht.HasDataTable = True Cht.ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False With SpaceAllocationSet .MoveLast NoPoints = .RecordCount .MoveFirst ' Get info all the same of each SpaceTypeID 'LblAngle = !LabelAngle DirectionUp = !StdLabPosUp DirectionLeft = !StdLabPosLeft LblXOffset = !StdXLabOffset LblYOffset = !StdYLabOffset Orientation = !StdLabOrientation LngRtn = SysCmd(acSysCmdInitMeter, "Labeling " & NoPoints & " points", NoPoints) ChtSeries.MarkerStyle = xlMarkerStyleX ChtSeries.MarkerSize = 4 ChtSeries.MarkerForegroundColorIndex = 3 ' Red ChtSeries.MarkerBackgroundColorIndex = xlColorIndexNone ' Enable Data Labels in the chart 'Loop through each data label and set its 'Top, Left, and Font properties For lCount = 1 To ChtSeries.Points.Count Set pntDataPoint = ChtSeries.Points(lCount) Err.Clear If pntDataPoint.HasDataLabel = True Then ' Add the data label and position it if necessary. Set ChtLabel = pntDataPoint.DataLabel ChtLabel.Position = xlLabelPositionCenter ChtLabel.Caption = !SpaceAndName Select Case DirectionUp Case "U" ' Up ChtLabel.Top = ChtLabel.Top - IncrementUp Case "D" ' Down ChtLabel.Top = ChtLabel.Top + IncrementUp Case Else MsgBox "Unrecognised Vertical Direction", vbCritical Exit Function End Select Select Case DirectionLeft Case "L" ' Left ChtLabel.Left = ChtLabel.Left - IncrementLeft Case "R" ' Right ChtLabel.Left = ChtLabel.Left + IncrementLeft Case Else MsgBox "Unrecognised Horizontal Direction", vbCritical Exit Function End Select ' Set angle ChtLabel.Orientation = Orientation ChtLabel.Font.Color = RGB(0, 0, 0) ' Black ChtLabel.Font.Size = 7 ChtLabel.Font.Name = "Arial" ChtLabel.Font.Bold = False .MoveNext LngRtn = SysCmd(acSysCmdUpdateMeter, lCount) End If Next .Close Set SpaceAllocationSet = Nothing End With AllocationPlan_Exit: LngRtn = SysCmd(acSysCmdRemoveMeter) LabelIt = True Exit Function AllocationPlan_Err: If Err.Number < glHANDLED_ERROR Then Err.Description = Err.Description & " (" & szSOURCE & ")" If bCentralErrorHandler(False) Then Stop Resume Next Else Resume AllocationPlan_Exit End If End Function |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code very slow
"Tim Williams" <timjwilliams at gmail dot com wrote in message ... Have you tried turning off screenupdating while the plot is being updated ? Tim Hi Tim Given it a go. No difference I'm afarid. Eitherway the chart does not change until the Exit Function is reached. Surprised, as I thought I would see the labels appearing Thanks, Phil "Phil Stanton" wrote in message ... I am labelling points on a scatter graph with boat names. There are 68 points on the graph and it takes over 90 seconds to run this routine. The computer is a fast dual core machine Any ideas why tis proceedure is so slow. The recordsource for the graph is SELECT QSpaceAllocation.XPos, QSpaceAllocation.YPos, QSpaceAllocation.SpaceAndName, QSpaceAllocation.StdLabPosLeft, QSpaceAllocation.StdXLabOffset, QSpaceAllocation.StdLabPosUp, QSpaceAllocation.StdYLabOffset, QSpaceAllocation.StdLabOrientation, QSpaceAllocation.XLabelPosition, QSpaceAllocation.YLabelPosition, QSpaceAllocation.LabelAngle FROM QSpaceAllocation ORDER BY QSpaceAllocation.XPos, QSpaceAllocation.YPos, QSpaceAllocation.SpaceAndName; The XPos and YPos are the positions of the points: The SpaceAndName is the label.Caption: Anything begining with Std is to do with positioning all the labels on the graph relative to the XY position. Other fields are for over-riding the standard position and orientation. I have half written the code to "Jiggle" the labels but as this is running so slowly, I am reluctant to proceed. Thanks Phil ' Label points with Standard offsets and angles Function LabelIt() As Boolean Dim Cht As Graph.Chart Dim ChtSeries As Series Dim ChtLabel As DataLabel Dim ChtArea As ChartArea Dim DataSht As DataSheet Dim pntDataPoint As Point Dim OrderPos As Integer Dim lCount As Long Dim DirectionUp As String Dim IncrementUp As Long Dim DirectionLeft As String Dim IncrementLeft As Long Dim Orientation As Integer Dim LblYOffset As Long, LblXOffset As Long Dim MyDb As Database Dim SpaceAllocationSet As Recordset Dim SQLStg As String, Stg As String Dim NoPoints As Integer Dim LngRtn As Long Const szSOURCE As String = "LabelIt()" Set MyDb = CurrentDb AllocationPlan.Refresh DoEvents Set Cht = Me.AllocationPlan.Object Set DataSht = Cht.Application.DataSheet 'ChartHeight = Cht.Height 'ChartWidth = Cht.Width Stg = Me.AllocationPlan.RowSource Stg = Left(Stg, Len(Stg) - 1) ' Remove last ; OrderPos = InStr(Stg, "ORDER BY") SQLStg = Left(Stg, OrderPos - 1) & "WHERE SpaceTypeID = " & SpaceTypeID SQLStg = SQLStg & " " & Mid(Stg, OrderPos) & ";" Set SpaceAllocationSet = MyDb.OpenRecordset(SQLStg) Set ChtSeries = Cht.SeriesCollection(1) Cht.HasDataTable = True Cht.ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False With SpaceAllocationSet .MoveLast NoPoints = .RecordCount .MoveFirst ' Get info all the same of each SpaceTypeID 'LblAngle = !LabelAngle DirectionUp = !StdLabPosUp DirectionLeft = !StdLabPosLeft LblXOffset = !StdXLabOffset LblYOffset = !StdYLabOffset Orientation = !StdLabOrientation LngRtn = SysCmd(acSysCmdInitMeter, "Labeling " & NoPoints & " points", NoPoints) ChtSeries.MarkerStyle = xlMarkerStyleX ChtSeries.MarkerSize = 4 ChtSeries.MarkerForegroundColorIndex = 3 ' Red ChtSeries.MarkerBackgroundColorIndex = xlColorIndexNone ' Enable Data Labels in the chart 'Loop through each data label and set its 'Top, Left, and Font properties For lCount = 1 To ChtSeries.Points.Count Set pntDataPoint = ChtSeries.Points(lCount) Err.Clear If pntDataPoint.HasDataLabel = True Then ' Add the data label and position it if necessary. Set ChtLabel = pntDataPoint.DataLabel ChtLabel.Position = xlLabelPositionCenter ChtLabel.Caption = !SpaceAndName Select Case DirectionUp Case "U" ' Up ChtLabel.Top = ChtLabel.Top - IncrementUp Case "D" ' Down ChtLabel.Top = ChtLabel.Top + IncrementUp Case Else MsgBox "Unrecognised Vertical Direction", vbCritical Exit Function End Select Select Case DirectionLeft Case "L" ' Left ChtLabel.Left = ChtLabel.Left - IncrementLeft Case "R" ' Right ChtLabel.Left = ChtLabel.Left + IncrementLeft Case Else MsgBox "Unrecognised Horizontal Direction", vbCritical Exit Function End Select ' Set angle ChtLabel.Orientation = Orientation ChtLabel.Font.Color = RGB(0, 0, 0) ' Black ChtLabel.Font.Size = 7 ChtLabel.Font.Name = "Arial" ChtLabel.Font.Bold = False .MoveNext LngRtn = SysCmd(acSysCmdUpdateMeter, lCount) End If Next .Close Set SpaceAllocationSet = Nothing End With AllocationPlan_Exit: LngRtn = SysCmd(acSysCmdRemoveMeter) LabelIt = True Exit Function AllocationPlan_Err: If Err.Number < glHANDLED_ERROR Then Err.Description = Err.Description & " (" & szSOURCE & ")" If bCentralErrorHandler(False) Then Stop Resume Next Else Resume AllocationPlan_Exit End If End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Slow Code | Excel Programming | |||
Slow code when used as VBA code instead of macro (copying visible columns) | Excel Programming | |||
Better Way To Do This SLOW code | Excel Programming | |||
Slow Code | Excel Programming | |||
Is this slow code? | Excel Programming |