MS-Excel v11.8169.8172 SP3 progressively slows down VBA Slowdown after using Shape.Nodes.SetPosition repeatedly on the nodes of msoFreeform shape objects. Why and what can I do about it ?
The code responsible for invoking Shape.Nodes.SetPosition repeatedly is listed below. Note that this code does NOT create any new shape objects (that is done in another function but only once).
Here is a link to the entire MS-Excel workbook with the complete VBA code.
http://ploxis.com/Bubbles.xls
When you open it, change the number in the RED cell from 0 to 1 ...and observe as that VBA code creates 34 msoFreeform shape objects and manipulates their nodes.
Note, that each subsequent invocation of the Bubbles() UDF runs slower and slower.
After it finishes updating the 34 msoFreeform shape objects, change the RED cell back to 0 and observe the update again (note that NO NEW shape objects are created the second time).
Note, that it is slower and slower...
The code responsible for invoking Shape.Nodes.SetPosition repeatedly is listed below. Note that this code does NOT create any new shape objects (that is done in another function but only once).
VBA Code:
Private Sub Animate(shp As Shape, ByVal steps As Integer, ByRef GapNodesArray() As GAPNODES)
Dim r As Double
Dim tt As Double
Dim xx As Double
Dim x, y, d, xd, yd, t As Double
Dim rx, ry, rd, rxd, ryd, rt As Double
Dim xL, xR As Double
Dim yc As Double
Dim ymin, ymax As Single
Dim i As Integer
r = shp.Nodes(4).Points(1, 2) - shp.Nodes(1).Points(1, 2)
tt = r / 1.8
t = tt
yc = shp.Nodes(1).Points(1, 2)
For xx = 0.0001 * r To 0.9999 Step (0.9999 / steps)
x = r * (xx ^ 4) 'the exponent affect the animation speed variation profile
rx = r - x
y = Sqr(r ^ 2 - rx ^ 2)
d = (rx / r) / (Sqr(1 - (rx / r) ^ 2))
xd = Sqr(t ^ 2 / (1 + d ^ 2))
yd = Sqr(t ^ 2 / (1 + (1 / (d ^ 2))))
ry = Sqr(r ^ 2 - x ^ 2)
rd = (x / r) / (Sqr(1 - (x / r) ^ 2))
rxd = Sqr(rt ^ 2 / (1 + rd ^ 2))
ryd = Sqr(rt ^ 2 / (1 + (1 / (rd ^ 2))))
Application.ScreenUpdating = False
For i = LBound(GapNodesArray) To UBound(GapNodesArray)
xL = GapNodesArray(i).xL
xR = GapNodesArray(i).xR
If GapNodesArray(i).Dir Then
shp.Nodes.SetPosition GapNodesArray(i).BL, xL, yc + y '7
shp.Nodes.SetPosition GapNodesArray(i).BR, xR, yc + y '10
shp.Nodes.SetPosition GapNodesArray(i).TL, xL, yc - y '61
shp.Nodes.SetPosition GapNodesArray(i).TR, xR, yc - y '58
shp.Nodes.SetPosition GapNodesArray(i).BL - 1, xL - xd, yc + y + yd
shp.Nodes.SetPosition GapNodesArray(i).BR + 1, xR + xd, yc + y + yd
shp.Nodes.SetPosition GapNodesArray(i).TL + 1, xL - xd, yc - y - yd
shp.Nodes.SetPosition GapNodesArray(i).TR - 1, xR + xd, yc - y - yd
If yd > y Then yd = y
shp.Nodes.SetPosition GapNodesArray(i).BL + 1, xL + xd, yc + y - yd
shp.Nodes.SetPosition GapNodesArray(i).BR - 1, xR - xd, yc + y - yd
shp.Nodes.SetPosition GapNodesArray(i).TL - 1, xL + xd, yc - y + yd
shp.Nodes.SetPosition GapNodesArray(i).TR + 1, xR - xd, yc - y + yd
Else
shp.Nodes.SetPosition GapNodesArray(i).BL, xL, yc + ry
shp.Nodes.SetPosition GapNodesArray(i).BR, xR, yc + ry
shp.Nodes.SetPosition GapNodesArray(i).TL, xL, yc - ry
shp.Nodes.SetPosition GapNodesArray(i).TR, xR, yc - ry
shp.Nodes.SetPosition GapNodesArray(i).BL - 1, xL - rxd, yc + ry + ryd
shp.Nodes.SetPosition GapNodesArray(i).BR + 1, xR + rxd, yc + ry + ryd
shp.Nodes.SetPosition GapNodesArray(i).TL + 1, xL - rxd, yc - ry - ryd
shp.Nodes.SetPosition GapNodesArray(i).TR - 1, xR + rxd, yc - ry - ryd
If ryd > ry Then ryd = ry
shp.Nodes.SetPosition GapNodesArray(i).BL + 1, xL + rxd, yc + ry - ryd
shp.Nodes.SetPosition GapNodesArray(i).BR - 1, xR - rxd, yc + ry - ryd
shp.Nodes.SetPosition GapNodesArray(i).TL - 1, xL + rxd, yc - ry + ryd
shp.Nodes.SetPosition GapNodesArray(i).TR + 1, xR - rxd, yc - ry + ryd
End If
Next i
Application.ScreenUpdating = True
t = tt * (rx / r)
rt = tt * (x / r)
Next xx
ymin = shp.Nodes(shp.Nodes.Count - 2).Points(1, 2)
ymax = shp.Nodes(4).Points(1, 2)
Application.ScreenUpdating = False
For i = LBound(GapNodesArray) To UBound(GapNodesArray) 'Do the last iteration to avoid divisions by zero and firmly set the vertical coordinate to ymin, yc, ymax
xL = GapNodesArray(i).xL
xR = GapNodesArray(i).xR
If GapNodesArray(i).Dir Then
shp.Nodes.SetPosition GapNodesArray(i).BL, xL, ymax
shp.Nodes.SetPosition GapNodesArray(i).BR, xR, ymax
shp.Nodes.SetPosition GapNodesArray(i).TL, xL, ymin
shp.Nodes.SetPosition GapNodesArray(i).TR, xR, ymin
shp.Nodes.SetPosition GapNodesArray(i).BL - 1, xL, ymax
shp.Nodes.SetPosition GapNodesArray(i).BR + 1, xR, ymax
shp.Nodes.SetPosition GapNodesArray(i).TL + 1, xL, ymin
shp.Nodes.SetPosition GapNodesArray(i).TR - 1, xR, ymin
shp.Nodes.SetPosition GapNodesArray(i).BL + 1, xL, ymax
shp.Nodes.SetPosition GapNodesArray(i).BR - 1, xR, ymax
shp.Nodes.SetPosition GapNodesArray(i).TL - 1, xL, ymin
shp.Nodes.SetPosition GapNodesArray(i).TR + 1, xR, ymin
Else
shp.Nodes.SetPosition GapNodesArray(i).BL, xL, yc
shp.Nodes.SetPosition GapNodesArray(i).BR, xR, yc
shp.Nodes.SetPosition GapNodesArray(i).TL, xL, yc
shp.Nodes.SetPosition GapNodesArray(i).TR, xR, yc
shp.Nodes.SetPosition GapNodesArray(i).BL - 1, xL, yc + tt
shp.Nodes.SetPosition GapNodesArray(i).BR + 1, xR, yc + tt
shp.Nodes.SetPosition GapNodesArray(i).TL + 1, xL, yc - tt
shp.Nodes.SetPosition GapNodesArray(i).TR - 1, xR, yc - tt
shp.Nodes.SetPosition GapNodesArray(i).BL + 1, xL, yc
shp.Nodes.SetPosition GapNodesArray(i).BR - 1, xR, yc
shp.Nodes.SetPosition GapNodesArray(i).TL - 1, xL, yc
shp.Nodes.SetPosition GapNodesArray(i).TR + 1, xR, yc
End If
Next i
Application.ScreenUpdating = True
End SubHere is a link to the entire MS-Excel workbook with the complete VBA code.
http://ploxis.com/Bubbles.xls
When you open it, change the number in the RED cell from 0 to 1 ...and observe as that VBA code creates 34 msoFreeform shape objects and manipulates their nodes.
Note, that each subsequent invocation of the Bubbles() UDF runs slower and slower.
After it finishes updating the 34 msoFreeform shape objects, change the RED cell back to 0 and observe the update again (note that NO NEW shape objects are created the second time).
Note, that it is slower and slower...
