Макросы VBA необходимы для решения проблемы.
Если вам никогда раньше не приходилось работать с VBA (вам повезло), вы можете изучить эту тему в статье Microsoft:Начало работы с VBA в PowerPoint 2010.
Вам понадобятся следующие два макроса: GetShapeRounding и SetShapeRounding.
Оба макроса предполагают, что прямоугольник со скругленными углами является текущей выбранной формой. Первый макрос вычисляет размер радиуса фигуры в точках, а второй устанавливает выбранную фигуру в этот радиус.
Использование макросов осуществляется путем:
- Создайте прямоугольник с закругленными углами и выберите его (или оставьте его выделенным)
- Запустите первый макрос, чтобы вычислить радиус
- Измените размер прямоугольника с закругленными углами и оставьте его выделенным
- Запустите второй макрос, чтобы установить его углы на рассчитанный радиус
Вот макросы:
Dim sngRadius As Single ' Radius size in points
Sub GetShapeRounding()
Dim oSh As Shape
Set oSh = ActiveWindow.Selection.ShapeRange(1)
With oSh
If .Width < .Height Then
sngRadius = .Width * .Adjustments(1)
Else ' .Width >= .Height
sngRadius = .Height * .Adjustments(1)
End If
End With
MsgBox sngRadius
Set oSh = Nothing
End Sub
Sub SetShapeRounding()
Dim oSh As Shape
Set oSh = ActiveWindow.Selection.ShapeRange(1)
With oSh
If .Width < .Height Then
.Adjustments(1) = sngRadius / .Width
Else ' .Width >= .Height
.Adjustments(1) = sngRadius / .Height
End If
End With
Set oSh = Nothing
End Sub
Проверено на PowerPoint 2010.