分享一个按照固定单位调整 Powerpoint 圆角矩形的 VB 代码

Powerpoint 的圆角矩形，调整 Border Radius 的单位是相对于形状本体尺寸的百分比。

如果想要用一个绝对单位去控制其圆角大小，使得任意尺寸的矩形圆角都一致的话，需要通过简单的单位换算，求得目标 pt 与短边之间相对的百分比，并将这个数值应用到形状上。

代码由 GPT 辅助生成。

Sub SetRoundedAndTopRoundedCorners() Dim selectedShape As Shape Set selectedShape = ActiveWindow.Selection.ShapeRange(1) ' Dim adj As Adjustments Set selectedShapeAdj = selectedShape.Adjustments ' 输入您想要的固定圆角磅值 Dim fixedRadiusPoints As Double fixedRadiusPoints = 8 ' 您可以根据需要进行调整 ' 获取矩形的宽度和高度 Dim rectWidth As Double Dim rectHeight As Double rectWidth = selectedShape.Width rectHeight = selectedShape.Height ' 获取矩形的短边 Dim shortSide As Double If rectWidth <= rectHeight Then shortSide = rectWidth Else shortSide = rectHeight End If ' 计算比例 Dim scaleFactor As Double scaleFactor = fixedRadiusPoints / shortSide ' 设置圆角大小 If selectedShape.AutoShapeType = msoShapeRoundedRectangle Then ' 圆角矩形 selectedShape.Adjustments.Item(1) = scaleFactor ElseIf selectedShape.AutoShapeType = msoShapeRound2SameRectangle Then ' 圆顶角矩形 selectedShape.Adjustments.Item(1) = scaleFactor selectedShape.Adjustments.Item(2) = 0 End If End Sub 

使用方法：

1. 启动“开发工具”选项卡，在“Virtual Basic”中新建一个模块，粘贴上述代码，修改fixedRadiusPoints为目标值
2. 选中一个圆角矩形，运行该代码

缺点：

暂不支持批量选择，每次只能修改一个圆角矩形