Ошибка выполнения «1004»: Microsoft Excel не может вставить данные

Question

Я посмотрел на вопрос и увидел несколько решений, связанных с такими вещами, как Select или с защищенными рабочими листами, но ни одно из них не относится ко мне здесь.

По разным причинам я не могу опубликовать весь код, но я дам описание того, что он делает, и опубликую точную подпрограмму, которая вызывает у меня проблемы.

У меня есть макрос, который генерирует несколько рабочих листов на основе введенного пользователем месяца и года (например, «1» - «31» или «1» - «30» и т. Д. c). Чтобы сгенерировать эти рабочие листы, макрос создает копии рабочего листа с подходящим названием «ПРИМЕР». Одна вещь, которая копируется, - это картинка (просто прямоугольник со словом «Экспорт»), к которой прикреплен макрос.

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

"Время выполнения ошибка «1004»: Microsoft Excel не может вставить данные. "

И параметры для" Завершить "," Отладка "и" Справка "

Если я выберу" Отладка ", это указывает на секунду макрос, который вызывается во время процесса генерации макроса '

Sub CopyAllShapes()
Dim ws As Worksheet

' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")

' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a 
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
    If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
        Sheets("EXAMPLE").Shapes("Picture 1").Copy
        ws.Range("J62").PasteSpecial
        ws.Shapes("Picture 1").OnAction = "Export"
    End If
Next ws

Application.CutCopyMode = xlCopy
End Sub

Опция Debug выделяет строку

ws.Range("J62").PasteSpecial

Что меня действительно смущает, так это то, что если я выбираю «End» вместо «Отладка», макрос останавливается, но на всех листах вставлена ​​картинка, а также назначен макрос экспорта, и все работает, как ожидалось. Если бы я был единственным человеком, использующим это, это было бы незначительным раздражением, но этот документ используется многими людьми, которым нельзя с уверенностью сказать "просто игнорировать" ошибку. Поскольку макрос работает должным образом, как я могу устранить причину проблемы и устранить ошибку go?

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

Answer 1

Просто хотел, чтобы все знали, что я нашел (своего рода) решение. Основываясь на ответах / комментариях Тима Уильямса и Питера, я изменил код так:

Sub CopyAllShapes()
Dim ws As Worksheet

' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")

' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a 
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
    If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
        Sheets("EXAMPLE").Shapes("Picture 1").Copy
    On Error Resume Next
        ws.Range("J62").PasteSpecial
    On Error Goto 0
        ws.Shapes("Picture 1").OnAction = "Export"
    End If
Next ws

Application.CutCopyMode = xlCopy
End Sub

Это успешно проигнорировало ошибку, и теперь все работает правильно! Спасибо всем за вашу помощь, надеюсь, это поможет кому-то еще в будущем!

Answer 2

Не совсем исправление, но этот код будет повторять Копировать / Вставить в случае неудачи (до 3 раз), вместо того, чтобы просто отбросить его:

Const MaxRetries AS Long = 3

Sub CopyAllShapes()
    Dim ws As Worksheet
    Dim TimesRetried As Long

    ' Sets the non-generated worksheets as an array
    nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")

    ' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a 
    ' seperate Macro called "Export" to the picture on each of these sheets.
    For Each ws In ActiveWorkbook.Worksheets
        If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
            TimesRetried = 0
CopyExampleShape:
            On Error Resume Next
            Sheets("EXAMPLE").Shapes("Picture 1").Copy
            ws.Range("J62").PasteSpecial
            'If the Copy/Paste fails, retry
            If Err Then
                On Error GoTo -1 'Clear the Error
                'Don't get stuck in an infinite loop
                If TimesRetried < MaxRetries Then
                    'Retry the Copy/paste
                    TimesRetried = TimesRetried + 1
                    DoEvents
                    GoTo CopyExampleShape
                End If
            End If
            On Error GoTo 0
            ws.Shapes("Picture 1").OnAction = "Export"
        End If
    Next ws

    Application.CutCopyMode = xlCopy
End Sub

У меня есть сталкивался с подобной проблемой раньше, и это была до другая программа (в одном случае Skype), реагирующая на данные, добавляемые в буфер обмена, «проверяя» его. Затем он ненадолго заблокировал буфер обмена, поэтому операция Paste / PasteSpecial завершилась неудачно. Это затем привело к чистой очистке буфера обмена ... Все без Excel , делающего что-то не так.

"Возможно совершить нет ошибки и все равно проигрывают. Это не слабость, это жизнь. " ~ Жан-Лу c Пикард

Answer 3

При переходе на Office 365 и Win10 (не могу сказать, кто из них был виновником) я обнаружил кучу существующих макросов, которые выдали бы ту же ошибку при попытке вставить скопированное изображение на лист.

При вводе отладки строка «вставить» будет подсвечена, но если я нажму «Продолжить», она (после одной или двух попыток) будет работать без ошибок.

Я закончил тем, что сделал:

'paste problem fix
Sub PastePicRetry(rng As Range)
    Dim i As Long
    Do While i < 20
        On Error Resume Next
        rng.PasteSpecial
        If Err.Number <> 0 Then
            Debug.Print "Paste failed", i
            DoEvents
            i = i + 1
        Else
            Exit Do
        End If
        On Error GoTo 0
        i = i + 1
    Loop
End Sub

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

РЕДАКТИРОВАТЬ: очищен и переработан в автономный саб.