copy & paste a picture from one sheet to another - excel

Question

I created a small program using the following code to transfer a picture from one sheet to another in the same workbook.
Sub transferPicturesPAPER_EXAM(pictureNo As Long, p As Integer, srcSht As String, dstSht As String, insertWhere As String)
' Transfers the selected Picture to the exam sheet.
''zxx
If pictureNo = 0 Then Exit Sub
Sheets(srcSht).Select
ActiveSheet.Unprotect
ActiveSheet.pictures("Picture " & pictureNo).Select
'ActiveSheet.Shapes.Range(Array("Picture " & pictureNo)).Select
Selection.Copy
Sheets(dstSht).Select
Range(insertWhere).Select
ActiveSheet.Paste
'== rename to correspond to the problem number
Selection.Name = "Picture " & p
End Sub
This works fine. However, when I place the routine in a larger workbook, I get the following error at the line: Activesheet.paste:
Paste method of Worksheet class failed
The code worked fine for several program executions.
Any help would be greatly appreciated.

Answer 1

Try this :
Sub transferPicturesPAPER_EXAM(pictureNo As Long, _
p As Integer, srcSht As String, _
dstSht As String, insertWhere As String)
' Transfers the selected Picture to the exam sheet.
''zxx
Dim pic As Picture
If pictureNo = 0 Then Exit Sub
Application.EnableEvents = False
Sheets(srcSht).Unprotect
Set pic = Sheets(srcSht).Pictures("Picture " & pictureNo)
pic.Copy
Sheets(dstSht).Activate
Sheets(dstSht).Range(insertWhere).Select
Sheets(dstSht).Paste
'== rename to correspond to the problem number
Selection.Name = "Picture " & p
Application.EnableEvents = True
End Sub

Answer 2

Try this one :
Sub transferPicturesPAPER_EXAM(pictureNo As Long, p As Integer, srcSht As String, dstSht As String, insertWhere As String)
' Transfers the selected Picture to the exam sheet.
''zxx
Dim shpPictureToCopyAs Shape
If pictureNo = 0 Then Exit Sub
With Sheets(srcSht)
.Unprotect
Set shpPictureToCopy= .Shapes(pictureNo).Duplicate
shpPictureToCopy.Cut
End With
Sheets(dstSht).Range(insertWhere).PasteSpecial (xlPasteAll)
End Sub
I recommend disabling and enabling events and screen updating in the main procedure, from which this one has been called. Otherwise you can enable them when you dont want to. Something like this :
Sub MainProcedure() 'your sub name
Application.EnableEvents = False
Application.ScreenUpdating = False
Call transferPicturesPAPER_EXAM(1, 1, "Sheet1", "Sheet2", "A20") 'with your variables as arguments of course
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Answer 3

I often had this problem too. But you cannot wait 3 seconds per picture , it's too long. I work on 1000 pictures, it's gonna take for ever.
The core of the problem is that Excel copies to windows clipboard first, which is slow.
If you try to paste before the clipboard has the Pic , its will error.
So, some small steps needed for mass copying:
Clear clipbard (not always needed but it makes sure you are not working on older data)
Copy Pic
Test if Pic is in the Clipboard and wait until it is there (loop)
Paste
Here is the code (for Excel 64 bits) :
Option Explicit
'Does the clipboard contain a bitmap/metafile?
Public Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
'Open the clipboard to read
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal Hwnd As LongPtr) As Long
'clear clipboard
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
'Get a pointer to the bitmap/metafile
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr 'wformat as long ?
'Close the clipboard
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
'for waiting
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Clear_Clipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
Application.CutCopyMode = False
End Sub
Sub PastePic(Pic As Shape)
Dim Rg As Range
Dim T#
Dim Ligne&: Ligne = 5
Dim Sh_Vendeur As Worksheet
Set Sh_Vendeur = ThisWorkbook.Sheets(1)
Clear_Clipboard
Pic.Copy
Set Rg = Sh_Vendeur.Cells(Ligne, 2)
'wait until the clipboard gets a pic, but not over 3 seconds (avoid infinite loop)
T = Timer
Do
Waiting (2)
Loop Until Is_Pic_in_Clipboard Or Timer - T > 0.3
'Rg.Select
'Rg.PasteSpecial
Sh_Vendeur.Paste Destination:=Rg 'paste to a range without select
End Sub
Sub Waiting(ByVal Mili_Seconds&)
Sleep Mili_Seconds
End Sub
Function Is_Pic_in_Clipboard() As Boolean
If IsClipboardFormatAvailable(2) <> 0 Or IsClipboardFormatAvailable(14) <> 0 Then Is_Pic_in_Clipboard = True '2-14 =bitmap et Picture JPEG
End Function

Answer 4

The time delay produced weird results. In some instants some of the pictures were pasted and in others they weren't. Very inconsistent results.
Relocated the Application.wait ... code at the very beginning of the subroutine - ran the program several times - worked perfectly
Would never have guessed that solution.
Thanks to everyone who suggested a solution.

Answer 5

I had success by using the command "DoEvents" just after copying the picture. This way I do not get error when using Paste, otherwise I do.