PowerPoint VBA copy/paste Windows clipboard timing issue

I have some code that copies shapes from one slide to others in a deck, multiple times, often in excess of hundreds of times.

This is a snippet of the code I am using:

' Get a shape by the tag associated with it
Set oShp = ShapeByTag(TAGNAME, TAGVALUE)
' Copy the shape from the source slide and store its source position
oShp.Copy: ShapeTop = oShp.Top: ShapeLeft = oShp.Left
DoEvents
' Paste it to the target slide
Set oShp = oSld.Shapes.Paste(1)

Open in new window


The function ShapeByTag just loops through the shapes on the source slide looking for a tag name and value match, returning the shape object when found.

The code works on 99% of the machines it is installed on.

However, on some machines, it fails randomly around 5% of the time with an error -2147188160 "Automation Error" which I believe is indicative of the Windows clipboard being in some kind of 'not ready' state or maybe empty. Hence a timing issue?

I have tried adding the DoEvents line to cure it to no avail.

I also tried trapping the error and looping but when the error occurs, I end up with two copies of the pasted object on the slide:

' Get a shape by the tag associated with it
Set oShp = ShapeByTag(TAGNAME, TAGVALUE)
' Copy the shape from the source slide and store its source position
oShp.Copy: ShapeTop = oShp.Top: ShapeLeft = oShp.Left
DoEvents
' Paste it to the target slide
On Error Resume Next
retryPaste:
Set oShp = oSld.Shapes.Paste(1)
If err And oShp Is Nothing Then Err.Clear: Goto retryPaste

Open in new window


I've then inserted an arbitrary 0.1 second delay before the paste line to test the timing issue hypothesis (awaiting a reply from one user with the problem) but would like a better way of managing this that doesn't inject several seconds of delay for a large multiple run of the above code.

Is there a way to test if the clipboard is "ready" before pasting? Or is there some other way to handle this?

As an aside, I ran this simple speed check procedure on my test machines and the failing machine:

Sub BasicSpeedCheck()
  Dim counter As Double
  Dim StartTime As Single
  MsgBox "This will run for several seconds with no visible feedback." & vbCrLf & vbCrLf & _
    "Please wait for the answer after clicking ok!", vbOKOnly, "About to run..."
  StartTime = Timer
  For counter = 1 To 2 ^ 24
    DoEvents
  Next
  MsgBox "Time taken to run 2 ^ 24 = " & Timer - StartTime, vbOKOnly + vbInformation, "Basic VBA Speed Check"
End Sub

Open in new window


It returned between 13 and 170 seconds on my [no fault] test machines and 10 for the failing PC.
LVL 14
Jamie GarrochPowerPoint Consultant & DeveloperAsked:
Who is Participating?
 
Jamie GarrochPowerPoint Consultant & DeveloperAuthor Commented:
My test user has now confirmed that adding the arbitrary 0.1 second delay works so this confirms the problem is a dreaded timing issue. I have also since discovered that the numerical value for the Clipboard Format does not always return the same value across different PCs. So, this is what I am now trying:

' Main sub snippet:

        ShapeByTag(TAGNAME, TAGVALUE).Copy
        ' Wait for the clipboard to contain the PowerPoint shape and then paste it to the target slide
        WaitForClipboard
        Set oShp = .Shapes.Paste

' Wait until PowerPoint shape object is on the Windows clipboard
Public Sub WaitForClipboard()
  Do
    DoEvents
  Loop Until IsPPTonClipboard
End Sub

' Check if PowerPoint shape object is on the Windows clipboard
Public Function IsPPTonClipboard() As Boolean
  Dim lFormat As Long
  Dim sName As String
  
  If OpenClipboard(0&) = 0 Then Exit Function ' Could not open clipboard
  Do
    lFormat = EnumClipboardFormats(lFormat)
    sName = String(255, 0)
    GetClipboardFormatName lFormat, sName, Len(sName)
    If sName Like "*PowerPoint 12.0 Internal Shapes*" Then IsPPTonClipboard = True: Exit Do
  Loop Until lFormat = 0
  CloseClipboard
End Function

Open in new window

0
 
Jamie GarrochPowerPoint Consultant & DeveloperAuthor Commented:
I think I'm getting somewhere. I've done a lot of reading about the Windows clipboard and I didn't realise that when data is copied to the clipboard, Windows converts it to a number of different formats which the calling application can then paste back. So using the Win API CountClipboardFormats() to determine if the clipboard is empty won't suffice as it returns 17 when a PowerPoint shape is copied to the clipboard. I suspect that on a super fast machine, the VBA code is running faster than the Windows clipboard converter and that when VBA tries to paste the shape object back to the slide, the required format is not yet available.

I copied a PowerPoint shape to the clipboard and used this to list the clipboard formats that are created:

' Windows API declarations
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

' List the clipboard formats in the immediate pane
Public Sub ListClipboardFormats()
  Dim lFormat As Long
  Dim sName As String
  
  If OpenClipboard(0&) = 0 Then Exit Sub ' Could not open clipboard
  Do
    lFormat = EnumClipboardFormats(lFormat)
    sName = String(255, 0)
    GetClipboardFormatName lFormat, sName, Len(sName)
    If Not lFormat = 0 Then Debug.Print lFormat, sName
  Loop Until lFormat = 0
  CloseClipboard
End Sub

Open in new window


The output is this:

 49161        DataObject                                                                                                                                                                                                                                                     
 49332        Preferred DropEffect                                                                                                                                                                                                                                           
 49372        InShellDragLoop                                                                                                                                                                                                                                                
 49686        PowerPoint 12.0 Internal Shapes                                                                                                                                                                                                                                
 49166        Object Descriptor                                                                                                                                                                                                                                              
 49545        Art::GVML ClipFormat                                                                                                                                                                                                                                           
 49535        PNG                                                                                                                                                                                                                                                            
 49537        JFIF                                                                                                                                                                                                                                                           
 49533        GIF                                                                                                                                                                                                                                                            
 2                                                                                                                                                                                                                                                                           
 14                                                                                                                                                                                                                                                                          
 3                                                                                                                                                                                                                                                                           
 49695        PowerPoint 12.0 Internal Theme                                                                                                                                                                                                                                 
 49699        PowerPoint 12.0 Internal Color Scheme                                                                                                                                                                                                                          
 49171        Ole Private Data                                                                                                                                                                                                                                               
 8                                                                                                                                                                                                                                                                           
 17 

Open in new window


And the ones without names are internal formats as follows:

2 = CF_BITMAP
14 = CF_ENHMETAFILE
3 = CF_METAFILEPICT
8 = CF_DIB
17 = CF_DIBV5

Open in new window


So, I am now planning to detect the PowerPoint shape format 49686 (&HC216&) using this:

Function IsShapeOnClipboard() As Boolean
  If OpenClipboard(0&) = 0 Then Exit Function ' Could not open clipboard
  IsShapeOnClipboard = IsClipboardFormatAvailable(&HC216&)
  CloseClipboard
End Function

Open in new window


I will report back when tested with the user.

I may also use the following API depending on when the sequence number is changed (hopefully after all formats are available):

GetClipboardSequenceNumber 

Open in new window


But this all seems a bit 'heavy' when it should be possible to get VBA to wait for the Windows clipboard to be 'ready'!!!
0
 
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.