Выравнивание фигуры внутри другой фигуры и присвоение имен фигурам с помощью VBA (макросы) PowerPoint

Question

Я хотел бы выровнять (в данном случае по центру) фигуру (прямоугольник с круглыми углами) внутри остроконечного прямоугольника на слайде, т. Е. Центральная точка обеих фигур должна быть одинаковой при использовании VBA без использования «Выделения». ссылаться на них через имена (например, где бы эти две фигуры не были связаны, макрос должен их выравнивать), но не уверен, как начать.

Простите за объяснения непрофессионала. Любые мысли были бы действительно полезны и подтолкнули меня к началу.

Answer 1

В этом примере предполагается, что вы знаете или определяете с помощью своего кода имена фигур, которые вы хотите выровнять. Затем можно быстро настроить ShapeRange и использовать встроенные функции выравнивания в PowerPoint.

Option Explicit

Sub AlignMe()
    Dim theseShapeNames As Variant
    theseShapeNames = Array("Rectangle 3", "Rectangle 4", "Rectangle 5")

    Dim thisSlide As Slide
    Dim theseShapes As ShapeRange
    Set thisSlide = ActivePresentation.Slides(1)
    Set theseShapes = thisSlide.Shapes.Range(theseShapeNames)
    theseShapes.Align msoAlignCenters, msoFalse
End Sub

Answer 2

Вам нужно будет настроить цикл для проверки каждой фигуры на слайде, чтобы определить, является ли ее тип автофигурой, а затем, если ее автофигура имеет тип msoShapeRoundedRectangle или msoShapeRectangle.Поскольку каждый найден, вы должны хранить имя каждого в переменной.Если оба найдены, вы получите измерения left, top, width и height для каждого из них и установите эти значения так, чтобы центры выравнивались.

Sub CenterShapes()
  Dim oSlide As Slide
  Dim oShape As Shape
  Dim bFoundRRect As Boolean, bFoundRect As Boolean
  Dim RRectName$, RectName$
  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
      If oShape.Type = msoAutoShape Then
        If oShape.AutoShapeType = msoShapeRoundedRectangle Then
          bFoundRRect = True
          RRectName$ = oShape.Name
        End If
        If oShape.AutoShapeType = msoShapeRectangle Then
          bFoundRect = True
          RectName$ = oShape.Name
        End If
      End If
    Next oShape
    If bFoundRRect = True And bFoundRect = True Then
      RRectVCenter = oSlide.Shapes(RRectName$).Top + (oSlide.Shapes(RRectName$).Height / 2)
      RRectHCenter = oSlide.Shapes(RRectName$).Left + (oSlide.Shapes(RRectName$).Width / 2)
      RectVCenter = oSlide.Shapes(RectName$).Top + (oSlide.Shapes(RectName$).Height / 2)
      RectHCenter = oSlide.Shapes(RectName$).Left + (oSlide.Shapes(RectName$).Width / 2)
      VDif = RRectVCenter - RectVCenter
      HDif = RRectHCenter - RectHCenter
      oSlide.Shapes(RectName$).Top = oSlide.Shapes(RectName$).Top + VDif
      oSlide.Shapes(RectName$).Left = oSlide.Shapes(RectName$).Left + HDif
    End If
  Next oSlide
End Sub