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" <(E-Mail Removed)> wrote in message
news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
> news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
> > 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
news:(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
> news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
>> 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
> news:(E-Mail Removed)...
> > 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" <(E-Mail Removed)> wrote in message
> > news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
> >> 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
> >> > >
> >> > >
> >
> >
>
>

I'm sorry, but I am not following what you are trying to do. You say the
"location is different"... do you mean the coordinates you input and the
coordinates my function is using to calculate its results are not the same?
If so, yes, that is by design. The code was originally designed some 30
years or so ago for BASICA or GWBASIC (one of the original BASIC languages
on a PC) for use in the New Jersey Department of Transportation in the road
design group I worked for at the time. The coordinate system we worked with
had one coordinate in the 2,000,000s and the other in the 600,000s. In order
to reduce the size of the multiplications, I reduced 'translated' (moved)
the figure closer to the the origin along the Y-axis. This does change the
shape, so the calculated area will be the same as for figure in its original
location, but the numbers being derived in the intermediate stages are more
'manageable. Was that what you were referring to?

As to the area not changing properly when the shape is resized... can you
give me a before/after example that demonstrates this problem in my
function?

Rick


"Dave Shaw" <(E-Mail Removed)> wrote in message
news:32C0CAF6-2CF2-4C6B-920C-(E-Mail Removed)...
> 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
>> news:(E-Mail Removed)...
>> > 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" <(E-Mail Removed)> wrote in message
>> > news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
>> >> 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 it was a confusing post...

I have a freeform square (3.53cm x3.53cm). I created this by the following
code on a freeform to see what was going wrong:

Set nds = ActiveSheet.Shapes(Selection.Name).Nodes
nds.SetPosition 1, 0, 0
nds.SetPosition 2, 0, 0
nds.SetPosition 3, 0, 100
nds.SetPosition 4, 100, 100
nds.SetPosition 5, 100, 0

So it is located in the top left hand corner of the sheet.

Then I run both codes. They use the following positions for the nodes:

0,0
0,0
0,66.6664581298828
90.6637802124023,0

So in this case it calculates the area as being 6,044 when I know the area
is 100 x 100 = 10,000

If I then scale the square by 200% I end up with an area of 1,511 = 1/2^2

If I just stretch using a mouse or by using the height and with attribute
the area does not change.

However I have just drawn 2 shapes with different areas and it seems to work
- is it something to do with resizing?

Thanks

Dave

"Rick Rothstein (MVP - VB)" wrote:

> I'm sorry, but I am not following what you are trying to do. You say the
> "location is different"... do you mean the coordinates you input and the
> coordinates my function is using to calculate its results are not the same?
> If so, yes, that is by design. The code was originally designed some 30
> years or so ago for BASICA or GWBASIC (one of the original BASIC languages
> on a PC) for use in the New Jersey Department of Transportation in the road
> design group I worked for at the time. The coordinate system we worked with
> had one coordinate in the 2,000,000s and the other in the 600,000s. In order
> to reduce the size of the multiplications, I reduced 'translated' (moved)
> the figure closer to the the origin along the Y-axis. This does change the
> shape, so the calculated area will be the same as for figure in its original
> location, but the numbers being derived in the intermediate stages are more
> 'manageable. Was that what you were referring to?
>
> As to the area not changing properly when the shape is resized... can you
> give me a before/after example that demonstrates this problem in my
> function?
>
> Rick
>
>
> "Dave Shaw" <(E-Mail Removed)> wrote in message
> news:32C0CAF6-2CF2-4C6B-920C-(E-Mail Removed)...
> > 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
> >> news:(E-Mail Removed)...
> >> > 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" <(E-Mail Removed)> wrote in message
> >> > news:CD8836BB-3DB3-4805-9182-(E-Mail Removed)...
> >> >> 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
> >> >> > >
> >> >> > >
> >> >
> >> >
> >>
> >>
>
>