PowerPoint: как сохранить закругление углов при изменении размера закругленных прямоугольников, как в Adobe Illustrator?

Question

Я использую PowerPoint для создания макетов пользовательских интерфейсов.

Это легко, если вы используете правильные прямоугольники с острыми углами.

Трудно, когда вы используете скругленные прямоугольники.

Есть ли способ сохранить закругление угла закругленного прямоугольника при изменении его размера? В настоящее время, если вы измените размер прямоугольника со скругленными углами, закругленные углы соответственно увеличатся / уменьшатся. Это не то, что я хочу ... Я хочу изменить размеры только ширины и высоты прямоугольника, не изменяя радиус закругленной границы. Прямо как в CSS. Или как в Illustrator. Но в PowerPoint.

Answer 1

Макросы VBA необходимы для решения проблемы.

Если вам никогда раньше не приходилось работать с VBA (вам повезло), вы можете изучить эту тему в статье Microsoft:Начало работы с VBA в PowerPoint 2010.

Вам понадобятся следующие два макроса: GetShapeRounding и SetShapeRounding. Оба макроса предполагают, что прямоугольник со скругленными углами является текущей выбранной формой. Первый макрос вычисляет размер радиуса фигуры в точках, а второй устанавливает выбранную фигуру в этот радиус.

Использование макросов осуществляется путем:

1. Создайте прямоугольник с закругленными углами и выберите его (или оставьте его выделенным)
2. Запустите первый макрос, чтобы вычислить радиус
3. Измените размер прямоугольника с закругленными углами и оставьте его выделенным
4. Запустите второй макрос, чтобы установить его углы на рассчитанный радиус

Вот макросы:

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.

Answer 2

Я не думаю, что это возможно с PowerPoint из коробки.

Для этого вам нужно написать небольшой макрос VBA.

Существуют надстройки PowerPoint, которые позволяют унифицировать радиус угла (присвойте каждому ящику одинаковый радиус). Наш является одним из них: www.veodin.com/slideproof