Uniform Rounded Corners - Cool Code

A client sent a design for a Word template that had lots of boxes and photos with uniform rounded corners. Not an unreasonable request, but Office doesn't do that well. In PowerPoint, Word and Excel, rounded corners are proportional to the size of the shape. Making them uniform manually is picky and time-consuming. But with a dash of VBA, we can make the job easy.


The Math

As a round-cornered shape gets larger, the corner radius increases as well, in proportion to the shape size. Since we want to keep the radius the same size, we need to create a formula that makes a smaller number as the height and width increase. We need an inverse number! The simplest way to create an inverse is to divide 1 by the measurements. Then, we need a number to set the radius size: a constant. The formula looks like this: (1 / (Shape.Height + Shape.Width)) * RadiusFactor. And you thought you'd never need that high school math!

Here's VBA code that will work in Excel, Word and PowerPoint on a selection of round-cornered boxes:

Sub RoundedCorners()
  Dim oShape As Shape, RadiusFactor!
  RadiusFactor! = 50
  For Each oShape In ActiveWindow.Selection.ShapeRange
    With oShape
      If .AutoShapeType = msoShapeRoundedRectangle Then
        .Adjustments(1) = (1 / (oShape.Height + oShape.Width)) * RadiusFactor!
      End If
    End With
  Next oShape
End Sub

Uniform Rounded Corners for the Whole Document

To run this on a whole presentation, document or workbook, we need to customize the routine for each Office program. Here's the Excel version:

Sub RoundAllXLCorners()
  Dim oWorksheet As Worksheet, oShape As Shape, RadiusFactor!
  RadiusFactor! = 50
  For Each oWorksheet In ActiveWorkbook.Worksheets
    For Each oShape In oWorksheet.Shapes
      With oShape
        If .AutoShapeType = msoShapeRoundedRectangle Then
          .Adjustments(1) = (1 / (oShape.Height + oShape.Width)) * RadiusFactor!
        End If
      End With
    Next oShape
  Next oWorksheet
End Sub

To do the same in PowerPoint

Sub RoundAllPPCorners()
  Dim oSlide As Slide, oShape As Shape, RadiusFactor!
  RadiusFactor! = 50
  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
      With oShape
        If .AutoShapeType = msoShapeRoundedRectangle Then
          .Adjustments(1) = (1 / (oShape.Height + oShape.Width)) * RadiusFactor!
        End If
      End With
    Next oShape
  Next oSlide
End Sub

And finally, for Word

Sub RoundAllWDCorners()
  Dim oShape As Shape, RadiusFactor!
  RadiusFactor! = 50
  For Each oShape In ActiveDocument.Shapes
    With oShape
      If .AutoShapeType = msoShapeRoundedRectangle Then
        .Adjustments(1) = (1 / (oShape.Height + oShape.Width)) * RadiusFactor!
      End If
    End With
  Next oShape
End Sub
Before: Rounded Corners, but not Uniform
Rounded Corners, but not Uniform

The Word version is a little simpler because a Word document is one big object, while Excel and PowerPoint both have multiple objects for each worksheet and slide, respectively. But the similarites point out that when you're searching online for VBA code, finding something for a different program and modifying it can be a huge time-saver. By far, Excel has way more code written for it, so Excel VBA sites can be a fruitful source for Word and PowerPoint code ideas.

After: Uniform Rounded Corners
Uniform Rounded Corners

These macros have been tested under both Windows and macOS and work well under both.

4:03 pm

One thought on “Uniform Rounded Corners - Cool Code

Leave a Reply

*Required fields. Your email address will not be published.

Posting XML? To enter XML code, please replace all less than signs "<" with "&lt;" and greater than signs ">" with "&gt;". Otherwise, Wordpress will strip them out and you will see only a blank area where your code would have appeared.