Rounded Corner Should be constant in Powerpoint VBA script

Question

I was working on below given script to convert all the corners in rounded corners, but the rounded corners are not giving same values for all shapes.

I have worked on below scripts

Sub RoundedCorner5()


    Dim oShape As Shape
Dim sngRadius As Single ' Radius size in points

sngRadius = 0.05
For Each oShape In ActiveWindow.Selection.ShapeRange

    With oShape
         oShape.AutoShapeType = msoShapeRoundedRectangle
         oShape.TextFrame.WordWrap = msoFalse
         oShape.TextEffect.Alignment = msoTextEffectAlignmentCentered
        .Adjustments(1) = sngRadius
    End With
Next
Set oShape = Nothing

End Sub

Suppose if I have one small rectangle and one big rectangle the the rounded corner values come different for both shapes

Answer 1

By default, round corners are proportional to the shape size. Here is Microsoft's page about adjustments, please note that the units are not points: Adjustments object (PowerPoint)

This code should get you pretty close, change RadiusFactor to get the corner size you prefer:

Sub RoundedCorner5()
  Dim oShape As Shape
  Dim RadiusFactor As Single
  RadiusFactor = 50
  For Each oShape In ActiveWindow.Selection.ShapeRange
    With oShape
      .AutoShapeType = msoShapeRoundedRectangle
      .Adjustments(1) = (1 / (oShape.Height + oShape.Width)) * RadiusFactor
      .TextFrame.WordWrap = msoFalse
      .TextEffect.Alignment = msoTextEffectAlignmentCentered
    End With
  Next
End Sub