如何编写PowerPoint VBA宏，以便将形状“叠加”在彼此之上/彼此接触？

Question

我正试图找到一种方法来制作一个宏，这些宏彼此相邻地“堆叠”，有点像图腾柱的堆叠方式，形状基本上相互接触。这里的想法是，这对于人字形时间轴之类的项目或确保形状尽可能地接近而不重叠都非常有用。

到目前为止，假设我想从下往上堆叠，我的代码思考过程就是这样：

选择所有形状

对于选择中的形状：

收集每个形状的底部和顶部位置

使用最低的形状作为参考，将第二低的形状放在位置（最低的形状坐标减去形状高度）

使用第二低的形状作为参考，将第三低的形状放置在位置（第二低的形状形状减去第二个最低形状高度）

依此类推，直到所有形状都堆叠在一起为止。我想代码可以很容易地修改为从上到下堆叠，或从左到右堆叠。

最大的问题是，如何编写此代码？我已经完成了有关如何移动对象的教程，但似乎无法通过两个以上的对象来完成它。

这是我到目前为止所拥有的：

Sub Stack_on_top()
Dim Shp1 As Shape
Dim Shp2 As Shape
Dim x As Integer
Dim y As Integer

  x = Windows(1).Selection.ShapeRange.Count
  For y = 1 To x
    If Shp1 Is Nothing Then
      Set Shp1 = Windows(1).Selection.ShapeRange(y)
    Else
      Set Shp2 = Windows(1).Selection.ShapeRange(y)
          Shp2.Top = Shp1.Top - Shp2.Height
      End If
  Next y
End Sub

问题是，此代码仅对2个对象执行此操作，其余仅基于一个引用进行堆栈。任何帮助将不胜感激！

谢谢！

-约翰

Answer 1

尝试这样：

Sub Stack_on_top()

Dim Shp1 As Shape
Dim Shp As Shape
Dim x As Long
Dim sngLastY As Single

    Set Shp1 = ActiveWindow.Selection.ShapeRange(1)
    sngLastY = Shp1.Top

    For x = 2 To ActiveWindow.Selection.ShapeRange.Count
        Set Shp = ActiveWindow.Selection.ShapeRange(x)
        With Shp
            .Left = Shp1.Left
            .Top = sngLastY - .Height
            sngLastY = .Top
        End With
    Next

End Sub