CODEWITHSUNDEEP
vbapowerpoint
TechGeek
TechGeek

Reputation: 2212

PowerPoint VBA - Copy shape to a slide

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

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.

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

Below is the error message I get on Powerpoint 2016: enter image description here

Upvotes: 0

Views: 2505

Answers (1)

Jamie Garroch - MVP
Jamie Garroch - MVP

Reputation: 2979

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.

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

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

Upvotes: 2

Related Questions