PowerPoint VBA-将形状复制到幻灯片 [英] PowerPoint VBA - Copy shape to a slide

问题描述

我已经开发了Powerpoint VBA函数，并向其传递了Shape和Slide对象。

I have developed a Powerpoint VBA function to which I pass a Shape and Slide object.

该函数在其中查找带有文本LOGO的形状，如果找到，它将用我传递给该函数的形状替换该形状。

The function finds for a shape with text LOGO inside it, if it finds, it replaces that shape with the shape I passed to the function.

该功能在Office 2013上可以正常使用，但在Office 2016上则不能。

Function works perfectly on office 2013 but not on Office 2016.

有人可以为此建议一个解决方法吗？

Can anybody please suggest a work around for this?

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上收到的错误消息：

Below is the error message I get on Powerpoint 2016:

推荐答案

这是VBA / Clipboard / WinOS的。我亲自花费了数小时试图为此设计一个巧妙的解决方案，甚至在继续粘贴操作之前都使用WinAPI检查并等待剪贴板中的PowerPoint类型的内容可用，而无济于事。

That's the dreaded machine dependent timing issue with VBA/Clipboard/WinOS. I have personally spent hours trying to devise a clever solution for this, even using WinAPIs to check and wait for a PowerPoint type of content to be available in the clipboard before proceeding with a Paste operation, all to no avail.

我发现唯一可行的解​​决方案是延迟VBA的速度。讨厌的解决方法，因为它仍然取决于计算机。这是我使用的功能：

The only solution I have found that works is to slow VBA down with a delay. Nasty workaround as it's still machine dependent. This is the function I use:

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秒钟到失败的时间，然后再次加倍！），它应该可以解决您的问题：

If you call this as follows (reduce the time from 1 second until it fails and then double it again!), it should solve your issue:

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

这篇关于PowerPoint VBA-将形状复制到幻灯片的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！