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

我开发了一个 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

Below is the error message I get on Powerpoint 2016:

这就是 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