Create Harvey Balls

OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Create Harvey Balls programmatically

Harvey balls are great to assess quantitive information. We shall look at using the merge shapes functionality available in PowerPoint to create native shapes and also some caveats.
Supported versions: PowerPoint 2013+
The process here is to create a single composite shape from two individual shapes to arrive at the desire shape i.e. the 3/4 Harvey ball.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or 
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' -------------------------------------------------------------------------------

Sub CreateHarveyBall()
Dim shp1 As Shape
Dim shp2 As Shape

Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 100, 100, 50, 50)
Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapePie, 100, 100, 50, 50)
Call ActiveWindow.Selection.SlideRange(1).Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition)).MergeShapes(msoMergeCombine)
End Sub

The output upon executing the above code is:

The above code does not give us the expected result. The combine operation seems to have worked as a substract operation. Further investigation revealed that if absolute value of both adjustments of the pie (the yellow diamonds) are any of the following 0, 90, 180, 270 values then the combine behaves like a substract geometry operation. This looks like a bug in the combine geometry. Instead, if you set to a value of 90.01 then you get the expected behavior.

Sub CreateHarveyBall()
Dim shp1 As Shape
Dim shp2 As Shape

Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 200, 100, 50, 50)
Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapePie, 200, 100, 50, 50)

shp2.Adjustments(1) = shp2.Adjustments(1) + 0.1

Call ActiveWindow.Selection.SlideRange(1).Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition)).MergeShapes(msoMergeCombine)
End Sub

Adding a line to tweak the adjustment does the trick to give the desired result.