Скопируйте и вставьте изображение с одного листа на другой

Question

Я создал небольшую программу, используя следующий код для переноса изображения с одного листа на другой в той же книге.

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 

Это прекрасно работает. Тем не менее, когда я устанавливаю процедуру в большей книге, я получаю следующее сообщение об ошибке в строке: Activesheet.paste:

метод Paste класса Worksheet не удался

код работал штраф для нескольких программных казней.

Любая помощь была бы принята с благодарностью.

Answer 1

Попробуйте это:

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

Попробуйте это:

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 

Я рекомендую отключить и включение события и обновления экрана в главном порядке, из которого был назван этот один. В противном случае вы можете включить их, когда вы этого не хотите. Что-то вроде этого:

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

Временная задержка вызвала странные результаты. В некоторые моменты некоторые фотографии были вставлены, а в других - нет. Очень противоречивые результаты.

переместил Application.wait ... код в самом начале подпрограммы - запускал программу несколько раз - работал отлично

никогда бы не догадался, что решение. Спасибо всем, кто предложил решение.