Here's an example of using sheet data to control a shape:
Copy/Paste the following X1 values into A2:A9
240
273
318
377
459
419
378
303
Now these X2 values into B2:B9
239
311
311
382
429
358
358
286
Now these Y1 values into D2
9 (Column C is blank)
285
237
179
178
179
225
285
286
Now these Y2 values into E2:E9
254
234
190
170
210
236
277
301
Now anywhere on that sheet use the freeform builder to draw a closed
shape with exactly 8 nodal points (Click/release/drag 8 times then
finish off with a double click while holding the pointer over the start
of the curve)
Now name the shape by selecting it then typing "mycurve" (w/o the
quotes) in the name box on the left of the formula bar, then press
Enter.
Now paste the following code into a standard module.
When the code is running you should see the shape you drew (mycurve)
quickly move to a new position then morph between being a
parallelogram and a step shaped polygon five times.
The parallelogram shape is produced by the set of X1 and Y1 values, one
pair of values for each of the 8 nodal points.
The step shaped polygon is produced by the X2 and Y2 values.
Each nodal point moves linearly from (X1,Y1) to (X2,Y2) as the value of
k changes from 0 to 1 in steps of 0.02. Making this step size smaller
slows down the movement between the two shapes.
Public Sub FiveCycles()
Dim mycurve As Shape
Set mycurve = ActiveSheet.Shapes("mycurve")
Dim Xo() As Single, Xf() As Single
Dim Yo() As Single, Yf() As Single
Dim I As Integer, IntNodes As Integer
Dim j As Integer, k As Single
IntNodes = mycurve.Nodes.Count
ReDim Xo(IntNodes)
ReDim Xf(IntNodes)
ReDim Yo(IntNodes)
ReDim Yf(IntNodes)
For I = 1 To IntNodes
If Cells(I + 1, 1) = "" Or _
Cells(I + 1, 2) = "" Or _
Cells(I + 1, 4) = "" Or _
Cells(I + 1, 5) = "" Then
MsgBox "Not Enough Data for Nodal Points on Curve!"
Exit Sub
End If
Xo(I) = Cells(I + 1, 1)
Xf(I) = Cells(I + 1, 2)
Yo(I) = Cells(I + 1, 4)
Yf(I) = Cells(I + 1, 5)
Next I
Do While j < 5
j = j + 1
Do While k < 1
k = k + 0.02 'value affects speed
For I = 1 To IntNodes
mycurve.Nodes.SetPosition I, _
k * (Xf(I) - Xo(I)) + Xo(I), _
k * (Yf(I) - Yo(I)) + Yo(I)
Next I
Calculate
Loop
Do While k > 0
k = k - 0.02
For I = 1 To IntNodes
mycurve.Nodes.SetPosition I, _
k * (Xf(I) - Xo(I)) + Xo(I), _
k * (Yf(I) - Yo(I)) + Yo(I)
Next I
Calculate
Loop
Loop
End Sub
This code works on PC and Mac OS earlier than OS X. Microsoft changed
the way VBA works for Mac OS X. For it to work on the latest versions
of Office for Mac the Calculate lines have to be changed to DoEvents
and the mouse has to be continually moving while the code runs
otherwise no motion is observed, just initial and final positions
(which amounts to nothing since the shape finishes up where it
started.)
Ken Johnson