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

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

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

The following is a posted answer I once gave over in the compiled VB world,
but nothing in the code would preclude it from working within Excel's VBA
environment. Perhaps you can make use of it.

Rick

Back in the old days, before electronic calculators (we used to use an old
Monroe mechanical push button, mechanical crank handle jobber with about a
million gears in it), we used to calculate areas adding and subtracting
trapezoidal areas as we went in order around the nodes of the polygon. Here
is a VB adaptation of that procedure. For simplicity sake and to keep the
function wholly self-contained, I set it to take two arguments -- an array
of X-Coordinates and an array of Y-Coordinates (both of type Double).
Obviously they are linked by their indices -- Xcoord(N) and Ycoord(N) both
referring to the same Nth node on the polygon. The nodes *must* be store in
sequential order, one after the other as you travel either clockwise or
counter-clockwise around the polygon.

'Calculate the gross area of a polygon
'======================================
Function AreaByCoordinates(Xcoord() As Double, _
Ycoord() As Double) As Double
Dim I As Long
Dim Xold As Double
Dim Yold As Double
Dim Yorig As Double
Dim ArrayUpBound As Long
ArrayUpBound = UBound(Xcoord)
Xold = Xcoord(ArrayUpBound)
Yorig = Ycoord(ArrayUpBound)
Yold = 0#
For I = LBound(Xcoord) To ArrayUpBound
X = Xcoord(I)
Y = Ycoord(I) - Yorig
AreaByCoordinates = AreaByCoordinates + _
(Xold - X) * (Yold + Y)
Xold = X
Yold = Y
Next
AreaByCoordinates = Abs(AreaByCoordinates) / 2
End Function

Note: The Yorig is used to normalize all measurements around a common point
within or touching the polygon. The reason -- to minimize any errors that
might be generated by having the nodes "far" away from the (0,0) origin.
This is probably not needed, but since it adds a miniscule amount of
overhead to the time required to calculate the area, I opted to put it in.


"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

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

Rick and Peter

Thanks very much those are great.

Dave

"Peter T" wrote:

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

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

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