Knowing the area of a shape in PowerPoint can be very useful when wanting to visually represent a percentage of that shape.

Let’s say we have a map of a country represented by a vector shape in PowerPoint, Excel or Word and we want to visualise that half of that country is occupied by farm land. How could we do that?

We all know how to calculate the area of a square and numerous other geometric shapes but what about an irregular [polygon] shape in PowerPoint? Not so easy. Not in the slightest as you can imagine with this shape!

The VBA macro below solves this problem by examining all of the vertices (X/Y points) in the shape and calculating the area based on an unsightly mathematical formula which we won’t bore you with here.

There are a couple of caveats to note if you use this macro:

- Nodes around the perimeter of a shape in Microsoft Office applications don’t always refer to the real points that make up the outline path. Depending on the type of point, the node may refer to a point on the path or one of two control handles for the point that define a Bezier curve. The macro will check that all segments in the path are straight lines (as per the definition of a polygon) and will convert any curves it finds to straight segments to eliminate any control nodes. This conversion may affect the overall shape and hence its area.
- The shape must be a freeform shape. The macro can’t and won’t calculate the area of auto shapes such as squares and circles as these are a special type of shapes in PowerPoint (you can of course use the Merge tool in Office 2010 and onwards to convert the shape to a freeform by overlaying another shape above it and using the Intersect mode).
- The shape must be closed. If it’s not, just right click on it, select
**Edit Points**and then right click on the path before finally selecting**Close Path**.

## Result

Make sure a single closed freeform shape is selected before your run the macro. When you run it, a text box is added to the top left of the slide with the shape area. You’re then asked if you want to add a square to the slide equal to a given percentage of the area of the shape. This is the result for our US map after requesting a square equal to 50% of the area:

## Using The Macro

If you’ve never used a VBA macro in PowerPoint before, check out our short tutorial which explains how to insert a macro in PowerPoint for the PC or Mac.

Note: we’ve commented out the following line in the main GetShapeArea procedure because for shapes with many hundreds of points, changing the segment type takes a long time and makes it appear as if PowerPoint has crashed (which it hasn’t).

ShapeSegmentsToLine oShp

If you experience any issues with relatively simple shapes (tens of points), then uncomment this line (delete the apostrophe).

## The Macro

This macro is provided under the Creative Commons attribution licence. That means you’re free to use it and modify it and all we ask in return is that you credit us with the original creation as described in the code.

' VBA Macro to calculate the area of the selected irregular polygon shape '---------------------------------------------------------------------------------- ' Copyright (c) 2014 YOUpresent Ltd. ' Source code is provide under Creative Commons Attribution License ' This means you must give credit for our original creation in the following form: ' "Includes code created by YOUpresent Ltd. (YOUpresent.co.uk)" ' Commons Deed @ http://creativecommons.org/licenses/by/3.0/ ' License Legal @ http://creativecommons.org/licenses/by/3.0/legalcode '---------------------------------------------------------------------------------- ' Purpose : Calculates the are of the selected shape and optionally adds a square ' of the same area or a user-selected percentage of it. ' ' Author : Jamie Garroch ' Date : 08SEP2014 ' Website : http://youpresent.co.uk and http://www.gmark.co '---------------------------------------------------------------------------------- Option Explicit ' Main macro procedure Public Sub GetShapeArea() Dim oShp As Shape Dim vertices As Integer Dim myNode As Integer Dim oSld As Slide Dim coords() As Single Dim myVertices() As Single Dim myArea As Single, AreaIN As Single, AreaCM As Single Dim response ' Check that a single shape is selected If ActiveWindow.Selection.Type = ppSelectionShapes Then If ActiveWindow.Selection.ShapeRange.Count = 1 Then Set oShp = ActiveWindow.Selection.ShapeRange(1) Else MsgBox "Please select a single shape.", vbCritical + vbOKOnly, "Multiple shapes selected": Exit Sub End If Else MsgBox "Please select a shape.", vbCritical + vbOKOnly, "No shape selected": Exit Sub End If ' Check that the selected shape is a freeform If Not oShp.Type = msoFreeform Then MsgBox "Please select a freeform shape.", vbCritical + vbOKOnly, "Selected shape is not a freeform shape": Exit Sub ' Change segments to lines so that Bezier adjustment control nodes are ignored in the path 'ShapeSegmentsToLine oShp ' Check that the selected shape is closed If Not ShapeIsClosed(oShp) Then MsgBox "Please select a closed shape.", vbCritical + vbOKOnly, "Selected shape is not closed": Exit Sub Set oSld = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex) myVertices = oShp.vertices myArea = CalculateArea(myVertices) AreaIN = Round(myArea / (72 ^ 2), 2) AreaCM = Round(myArea / (72 ^ 2 / 2.54 ^ 2), 2) With oSld.Shapes Set oShp = .AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0) With oShp .TextFrame2.TextRange.Text = "Shape Area" & vbCrLf & _ AreaIN & " in2 (a square with sides " & Round(Sqr(AreaIN), 2) & Chr(34) & ")" & vbCrLf & _ AreaCM & " cm2 (a square with sides " & Round(Sqr(AreaCM), 2) & "cm)" .TextFrame2.AutoSize = msoAutoSizeShapeToFitText .TextFrame2.WordWrap = msoFalse End With End With response = MsgBox("Would you like to add a square shape representing a percentage of this area to your slide?", vbQuestion + vbYesNo, "Add Square?") If response = vbYes Then response = Val(InputBox("What percentage of the total area would you like?", "Enter percentage of area", "100%")) If IsNumeric(response) Then oSld.Shapes.AddShape msoShapeRectangle, 0, 0, CSng(Sqr(myArea * response / 100)), CSng(Sqr(myArea * response / 100)) End If End Sub ' Convert curved segments to straight segments to eliminate non path nodes Private Function ShapeSegmentsToLine(oShp As Shape) As Single Dim NodeIndex As Integer On Error Resume Next If Not oShp.Type = msoFreeform Then Exit Function With oShp For NodeIndex = .Nodes.Count To 1 Step -1 If .Nodes(NodeIndex).SegmentType = msoSegmentCurve Then .Nodes.SetSegmentType NodeIndex, msoSegmentLine ShapeSegmentsToLine = ShapeSegmentsToLine + 1 End If Next End With End Function ' Check to see if the referenced shape has a closed path Private Function ShapeIsClosed(oShp As Shape) As Boolean Dim FirstPoint() As Single, LastPoint() As Single Dim myVertices() As Single ' Save all of the vertices from the shape to an array myVertices = oShp.vertices ' Check the the first node's coordinates are the same as the last node e.g. closed path FirstPoint = oShp.Nodes(1).Points LastPoint = oShp.Nodes(oShp.Nodes.Count).Points If FirstPoint(1, 1) = LastPoint(1, 1) And FirstPoint(1, 2) = LastPoint(1, 2) Then ShapeIsClosed = True End Function ' Algorithm to calculate the area of an irregular polygon using its vertices Private Function CalculateArea(ByRef myVertices() As Single) Dim counter As Integer Dim mySum1 As Long, mySum2 As Long For counter = LBound(myVertices) To UBound(myVertices) - 1 mySum1 = mySum1 + (myVertices(counter, 1) * myVertices(counter + 1, 2)) mySum2 = mySum2 + (myVertices(counter + 1, 1) * myVertices(counter, 2)) Next CalculateArea = Abs(mySum1 - mySum2) / 2 End Function

As a checkpoint, I tried a “freepoint” circle using intersect method. So a 4″ circle in powerpoint yields 14.396in2 (should be 12.566in2)

Similarly a 3″circle yields 8.098in2 (should be 7.06858in2)

A 2″ square yields 4″ (correct)

It I can’t trust the code or a circle (many, Many polygons), why trust it for say a 54 point polygon? Why the discrepancy? Is there another, more lengthy code, that gives a better answer? Fiddling with some other ppi conversion doesn’t give a stable solution, either.

If you created a circle using the intersect method, your circular shape only has four vertices. Powerpoint makes the shape into a circle by using additional Bezier control points (the little white squares that appear when you click on a black-square vertex). This macro doesn’t handle the Bezier points; it assumes that the vertices completely define the shape. The macro calculates the area of a circle with many vertices correctly.

A vertex is the point, indicated by a black dot, where a curve ends or the point where two line segments meet in a freeform shape.

Hi, http://youpresent.co.uk ,

i want get the nodes position coordinates of freeform and not freeforms shapes irregular like a hearts shapes, stars shapes, in Excel 2013.

iam want convert standard shapes to freeforms without change number and position of nodes, appearence of shape, etc.

thanks

Flavio

Hi Flavio. You are free to modify the existing code to do what you want or you can request us to do it for you using our chargeable development service by using the Contact button at the top of this site. Thank you. Jamie.

love it