PowerPoint VBA - 将形状复制到幻灯片

Question

我开发了一个Powerpoint VBA函数，我传递了一个Shape和Slide对象。

该函数查找其中包含文本LOGO的形状，如果找到，则用我传递给函数的形状替换该形状。

  

功能在Office 2013上完美运行，但在Office 2016上则无效。

有人可以建议解决这个问题吗？

Public Sub AddLogo_ONE(shLogo As Shape, oSlide As PowerPoint.Slide)
    Dim sh As Shape

    For Each sh In oSlide.Shapes
        If sh.HasTextFrame Then
            If UCase(sh.TextFrame2.TextRange.Text) = "LOGO" Then
                oSlide.Select
                DoEvents: DoEvents
                shLogo.Copy
                With oSlide.Shapes.Paste
                    .LockAspectRatio = msoFalse
                    .Left = sh.Left
                    .Top = sh.Top - ((.Height - sh.Height) / 2)
                    .AlternativeText = "LogoMacro"
                    sh.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
                End With
                Exit For
            End If
        End If
    Next
End Sub

以下是我在Powerpoint 2016上收到的错误消息：

Answer 1

这是与VBA / Clipboard / WinOS相关的可怕的机器相关时序问题。我个人花了好几个小时试图为此设计一个聪明的解决方案，即使使用WinAPI来检查并等待PowerPoint类型的内容在剪贴板中可用，然后再进行粘贴操作，这一切都无济于事。

我发现的唯一解决方案是延迟降低VBA速度。讨厌的解决方法，因为它依然依赖于机器。这是我使用的功能：

Public Sub Delay(Seconds As Single, Optional DoAppEvents As Boolean)
  Dim TimeNow As Long
  TimeNow = Timer
  Do While Timer < TimeNow + Seconds
    If DoAppEvents = True Then DoEvents
  Loop
End Sub

如果你按照以下方式调用它（将时间从1秒减少到失败然后再加倍！），它应该可以解决你的问题：

shLogo.Copy
Delay 1, True
With oSlide.Shapes.Paste