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 length of the shortest side of the shape. Since we want to keep the radius the same size, we need to create a formula that makes a smaller number as the shorter side increases. We need an inverse number! We can create this by dividing the preferred corner radius by the short side size. And you thought you’d never need that high school math!

Here’s VBA code that will work in Excel, Word and PowerPoint on selected round-cornered boxes. Thanks to the Rembrandt Kuipers and Ernst Mathys who have commented below, this macro has been improved since it was originally published. Replace the number after sngRadius with your desired radius size in points.

Sub RoundedCornersFixedRadius()
    Dim oShape As Shape
    Dim sngRadius As Single
    sngRadius = 8.50394 'Radius size in points. 8.50394pt is equal to 3mm.

    For Each oShape In ActiveWindow.Selection.ShapeRange
        With oShape
            If .AutoShapeType = msoShapeRoundedRectangle Then
                LengthOfShortSide = IIf(.Width > .Height, .Height, .Width)
                .Adjustments(1) = sngRadius / LengthOfShortSide
            End If
        End With
    Next oShape
End Sub

To set rounded corners on a PowerPoint placeholder, open Slide Master view, select the placeholder and run the above macro.


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, sngRadius As Single
    sngRadius = 8.50394 'Radius size in points.

    For Each oWorksheet In ActiveWorkbook.Worksheets
        For Each oShape In oWorksheet.Shapes
            With oShape
                If .AutoShapeType = msoShapeRoundedRectangle Then
                    LengthOfShortSide = IIf(.Width > .Height, .Height, .Width)
                    .Adjustments(1) = sngRadius / LengthOfShortSide
                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, sngRadius As Single
    sngRadius = 8.50394 'Radius size in points.

    For Each oSlide In ActivePresentation.Slides
        For Each oShape In oSlide.Shapes
            With oShape
                If .AutoShapeType = msoShapeRoundedRectangle Then
                    LengthOfShortSide = IIf(.Width > .Height, .Height, .Width)
                    .Adjustments(1) = sngRadius / LengthOfShortSide
                End If
            End With
        Next oShape
    Next oSlide
End Sub

And finally, for Word

Sub RoundAllWDCorners()
    Dim oShape As Shape, sngRadius As Single
    sngRadius = 8.50394 'Radius size in points.

    For Each oShape In ActiveDocument.Shapes
        With oShape
            If .AutoShapeType = msoShapeRoundedRectangle Then
                LengthOfShortSide = IIf(.Width > .Height, .Height, .Width)
                .Adjustments(1) = sngRadius / LengthOfShortSide
            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.

To use these macros with other shapes, please see my article Every AutoShape – Cool Code for a downloadable reference file showing all AutoShapes along with their XML and VBA names. Then replace msoShapeRoundedRectangle with the mso shape name you need.

4:03 pm

20 thoughts on “Uniform Rounded Corners – Cool Code

  1. The same problem with inconsistent rounded corners exists in forms with only two rounded and two rectangular corners, which are in diametrically opposed positions.
    How can I change the script in order to adjust this particular form?

    Would be great to get a solution.

    • Those macros can be revised with different AutoShape names to work on others shapes. Please see Every AutoShape – Cool Code for a downloadable reference file showing all AutoShapes along with their XML and VBA names. In your example, changing msoShapeRoundedRectangle to msoShapeRound2DiagRectangle will have the desired effect.

  2. Very useful. The example shows shapes of roughly the same aspect ratio, however having run it with very different shapes it seemed the assumption of the average of the height and width is wrong. I get better results with this in PowerPoint:

    Sub RoundAllPPCorners()
      Dim oSlide As Slide, oShape As Shape, RadiusFactor!
    
      RadiusFactor! = 5
      For Each oSlide In ActivePresentation.Slides
        For Each oShape In oSlide.Shapes
          With oShape
            If .AutoShapeType = msoShapeRoundedRectangle Then
              minDim = oShape.Height
              If oShape.Width < oShape.Height Then
                minDim = oShape.Width
              End If
              .Adjustments(1) = (1 / minDim) * RadiusFactor!
            End If
          End With
        Next oShape
      Next oSlide
    End Sub
  3. Rembrandt, you are absolutely right.

    There’s a precise explanation about the meaning of the .Adjustments(1) properties to rounded rectangles at https://www.experts-exchange.com/articles/11096/How-to-set-and-determine-the-rounding-in-AutoShapes-with-VBA.html

    As a matter of fact, .Adjustments(1) *is* the factor which defines the radius as a fraction of the length of the shorter side: Radius (in points) = Length of shorter side * .Adjustments(1)

    which leads to the following version of the function (in the version for MSWord) which in my opinion names the effective relationships more clearly:

    Sub RoundAllWDCorners()
      Dim oShape As Shape
      Dim sngRadius As Single ' Radius size in points
      
      sngRadius = 8.85
      
      For Each oShape In ActiveDocument.Shapes
        With oShape
          If .AutoShapeType = msoShapeRoundedRectangle Then
            LengthOfShortSide = IIf(.Width 
            .Adjustments(1) = sngRadius / LengthOfShortSide
          End If
        End With
      Next oShape
    End Sub
    • I believe you are trying to include a greater than or less than sign in your code listing. As noted in the comments window, you must replace those with their HTML entities. Enter &gt; for a greater than sign and &lt; for less than.

  4. Is there a way to make this code work with image placeholders and textbox placeholders that use the rounded corner rectangle in the Master Slides?

    • As I commented on May 17, 2020, “Those macros can be revised with different AutoShape names to work on other shapes.” Just substitute the different shape name in the VBA code. My previous comment has a link to a reference document showing all shape names.

      • Yes, but I’m referring to the same shape, only used as a Placeholder in the Master Slides. So a Placeholder that is a rounded rectangle shape to place images into. I have tried to run a modification of this macro (it detects grouped items) but it doesn’t affect anything on the Master Slides.

  5. Hello,

    can you change that VBA Code that it works on the SlideMaster?

    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

    Thx a lot,
    Maria

  6. Thank you so much for this! It helped a lot. I looked at the original code posted and the code in the comments and was able to tweak it for my needs. I wanted the code to only affect the selected shapes, and I also wanted a more meaningful error message if nothing was selected. Here’s what I used, just in case it can be helpful for someone else…

    Sub RoundCorners()
    Dim oSlide As Slide, oShape As Shape, RadiusFactor!

    If ActiveWindow.Selection.Type = ppSelectionShapes Then
    RadiusFactor! = 16
    For Each oShape In ActiveWindow.Selection.ShapeRange
    With oShape
    If .AutoShapeType = msoShapeRoundedRectangle Then
    minDim = oShape.Height
    If oShape.Width < oShape.Height Then
    minDim = oShape.Width
    End If
    .Adjustments(1) = (1 / minDim) * RadiusFactor!
    End If
    End With
    Next oShape
    Else
    eh:
    MsgBox “You must have at least one rounded rectangle selected.”
    End If
    End Sub

  7. I’ve stumbled upon this when looking for a way to specify the corner radius in PowerPoint – thank you for sharing it! Is there any VBA code (I am absolutely not a coder!) that could apply a specified radius, in say mm, to selected shapes? It seems like this code sets the radius according to the proportions or the length of the sides of shapes on a per-slide basis, which is giving me a consistent radius within each slide, but a different radius on each slide. I need to make the radius a standard 3mm on all my slides irrespective of proportions or size of the shape, to comply with the brand I’m working with.

    [It’s extraordinary to me that this isn’t a standard built-in feature in PowerPoint – as a designer it seems such a blindingly obvious omission. On the official feedback portal there are multiple suggestions from users for this very thing but MS have so far not acted on them.]

    • Office shapes have always had round corners that are proportional to the shape size rather than an absolute radius size. Given that 40-year history and the necessity of maintaining backward compatibility, this is unlikely to ever change.

      Here’s a macro based on Ernst Mathys’ comment of April 2021. This is already set to create 3mm corners:

      Sub RoundedCornersFixedRadius()
          Dim oShape As Shape
          Dim sngRadius As Single
      
          sngRadius = 8.50394 'Radius size in points
      
          For Each oShape In ActiveWindow.Selection.ShapeRange
              With oShape
                  If .AutoShapeType = msoShapeRoundedRectangle Then
                      LengthOfShortSide = IIf(.Width > .Height, .Height, .Width)
                      .Adjustments(1) = sngRadius / LengthOfShortSide
                  End If
              End With
          Next oShape
      End Sub

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.