Sorry another question - i have used both methods and they come up with very
similar result. However if I resize the shape the area doesn't change
properly.

to see if I could find the reason I have tried to set the size of a shape
using VB to set the location but when it goes back through the function it
says that the location is different to where the locations are set to. Does
this make any sense?


"Rick Rothstein (MVP - VB)" wrote:

Thanks for the code assist showing the OP how to make use of my function. I
have never had to work with shapes before, so your posting has taught me a
little bit of how to work with them as well. Thank you.

Rick


"Peter T" <peter_t@discussions wrote in message
...
Another one -

Sub FreeformArea()
Dim p As Long, nxt As Long
Dim Ar As Single
Dim shp As Shape
Dim nds As ShapeNodes

Set shp = ActiveSheet.Shapes("Freeform 1")
'Set shp = Selection

If shp.Type < msoFreeform Then
MsgBox "not a Freeform"
Exit Sub
End If

Set nds = shp.Nodes

Ar = 0
For p = 1 To nds.Count
nxt = p + 1
If nxt nds.Count Then nxt = 1

Ar = Ar + (nds(nxt).points(1, 1) - nds(p).points(1, 1)) _
* (nds(p).points(1, 2) + nds(nxt).points(1, 2))
Next

Ar = Abs(Ar) / 2

MsgBox Ar & " square points"
' 72x72 points per sqr inch

End Sub

Regards,
Peter T

PS, to test Rick's try something like this

Sub test()
Dim nds As ShapeNodes
Dim i As Long
Dim result As Double

Set nds = ActiveSheet.Shapes("Freeform 1").Nodes
ReDim arrX(1 To nds.Count) As Double
ReDim arrY(1 To nds.Count) As Double
For i = 1 To nds.Count
arrX(i) = nds(i).points(1, 1)
arrY(i) = nds(i).points(1, 2)
Next

result = AreaByCoordinates(arrX, arrY)
MsgBox result
End Sub


"Dave Shaw" wrote in message
...
Sorry I'm not that clever, how do I use the function in a VB module -
I've
copied PolygonArea function but don't know what variable to feed it.

Thanks


"Gary''s Student" wrote:

See:

http://local.wasp.uwa.edu.au/~pbourk...etry/polyarea/


--
Gary''s Student - gsnu200762


"Dave Shaw" wrote:

I thought someone in the Excel group (original post in Word
programming) may
be able to help:

Thanks
___

Thanks for that but my problem is calculating freeform shapes -
someone could
draw any shape with straight lines (star, random polygon, etc.) - so
the
basic height x width does not work.

The concept to calculate I understand - the shape would need to be
broken
down into triangles, the area of each triange calculated and then
added
together. I can do this myself with a ruler and protractor - I'm
just
not
advanced enough at doing this using a macro - I'm rubbish at loops
and
never
really used VB for calculating angles and have no idea of how to
split
a
shape into triangles.

"Helmut Weber" wrote:

Hi Dave,

Sub Test456()
Dim x As Double
Dim y As Double
x = PointsToCentimeters(Selection.ShapeRange(1).Height )
y = PointsToCentimeters(Selection.ShapeRange(1).Width)
MsgBox Format(x * y, "#.00 cm²")
End Sub

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

__
Hi

I would like users to be able to draw freeform shapes (using straight
not
curved lines) and then to run a macro to calculate it's area in cm.
I
don't
mind if this is in Word 2003 or Excel 2007.

I have found some links on the web for excel methods but none of them
seem
to work - I get overflow errors.

Any ideas

Thanks