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

Question

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

该功能找到一个带有文字LOGO的形状，如果找到它，它会用我传递给该函数的形状替换该形状。

功能完美的作品在办公室2013，但不是在办公室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 

下面是错误消息我得到的简报2016年

Answer 1

这是用VBA /剪贴板/ 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