PowerPoint VBA，“针对每个”疑难解答帮助（带有复制粘贴）

debugcn 发表于 Dev

用户名

我正在尝试做一个循环，该循环将复制形状，然后将其粘贴到下面的幻灯片中。

我有20张幻灯片，其中有19张在坐标.Left = AA和.Top = BB处具有Shape（实际上是一组形状，文本框，imgs等。）。

    Dim Sld As Slide
    Dim Shp As Shape

For Each Shp In Sld.Shapes
        With Shp
            If .Type = msoGroup _
                And .Left = AA _
                And .Top = BB _
                Then
                    .Cut

                With ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex + 1)
                    .Shapes.Paste
                    .Left = CC
                    .Top = DD
                End With
            End If
        End With
    Next
Next Sld

这是我当前的代码，但我遇到的问题是它将剪切并粘贴所有形状，但不会复制到第一次复制Shape的幻灯片之后的下一张幻灯片中。

它将它们全部粘贴到运行宏时的以下幻灯片中。

例如，如果我在幻灯片4上运行宏，则.Left = AA和.Top = BB中的所有形状都将粘贴在幻灯片5中的.Left = CC和.Top = DD处

我想要的是，如果在幻灯片1中剪切了形状，我希望将其粘贴到幻灯片2中的.left = CC和.Top = DD。如果形状在幻灯片2中，我希望将其粘贴到幻灯片3中的.left = CC和.Top = DD处。等等。

预先感谢您的帮助。我已经坚持了一个多星期。

杰米·加洛奇（Jamie Garroch）-MVP

这个工作（经过测试）的示例有帮助吗？

Option Explicit

Const AA = 0
Const BB = 0
Const CC = 100
Const DD = 100

Sub MoveShapesBetweenSlides()
  Dim Sld As Slide
  Dim Shp As Shape
  For Each Sld In ActivePresentation.Slides
    For Each Shp In Sld.Shapes
      With Shp
        If .Type = msoGroup And .Left = AA And .Top = BB Then
          .Cut
          ' Create an index to the next slide
          Dim lNextSld As Long
          If Sld.SlideIndex = ActivePresentation.Slides.Count Then
            lNextSld = 1
          Else
            lNextSld = Sld.SlideIndex + 1
          End If
          ' Paste the shape from the previous slide to the next slide and reposition it
          With ActivePresentation.Slides(lNextSld)
            With .Shapes.Paste
              .Left = CC
              .Top = DD
            End With
          End With
        End If
      End With
    Next Shp
  Next Sld
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。