Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

При вставке из VBA картинки на лист ошибка "Метод paste из класса worksheet завершен неверно"

Ничто в мире не идеально, и Excel тоже. Как и любая программа он порой может сильно удивлять разными "непонятками". Вот очередная шутка: казалось бы простой код по копированию и вставке картинки из листа Excel, который отлично работает в 2010, вылетает в 2016 с ошибкой Метод paste из класса worksheet завершен неверно:
Ошибка при вставке картинки
Сам код простой и ошибки в общем-то вызывать не должен:

Sub CopyPastePicture()
    ActiveWorkbook.Sheets("PICS").Shapes("Picture1").Copy
    ActiveWorkbook.Sheets("MAIN").Paste
End Sub

При этом самое печально то, что это даже не на каждом ПК проявляется. А при пошаговой отладке кода и вовсе пропадает. Т.е. для получения ошибки недостаточно одного Excel 2016, здесь влияет несколько факторов: установленные программы, операционная система, метод выполнения и т.д. и т.п. Разбирать каждый частный случай не представляется возможным. Да и даже если найти причину - что, теперь надо удалять все лишнее, что не понравилось Excel-ю? А почему тогда это лишнее не мешает тому же коду в Excel 2010? А если этот код - часть программы на заказ? Заказчик скажет "Тыжпрограммист" и будет прав - это наша проблема, проблема разработчиков. Мы обязаны знать эти подводные камни или как минимум хоть уметь вовремя их устранять. Поэтому приходится искать обходные пути. Судя по ошибке, сам корень зла где-то по пути от буфера к Excel. Возможно, наша скопированная картинка просто не до конца "прогрузилась" в буфер и надо дождаться завершения этой прогрузки. Текст ошибки несколько укрепляет это предположение. Первый порыв - использовать DoEvents, чтобы передать эстафету операционной системе - дать ей завершить свои процессы, в том числе и обработку буфера обмена:

Sub CopyPastePicture()
    ActiveWorkbook.Sheets("PICS").Shapes("Picture1").Copy
    DoEvents
    ActiveWorkbook.Sheets("MAIN").Paste
End Sub

Но это не спасает ситуацию. Равно как не спас и цикл с сотней DoEvents:

Sub CopyPastePicture()
    Dim i As Long
    ActiveWorkbook.Sheets("PICS").Shapes("Picture1").Copy
    For i = 1 To 100: DoEvents: Next
    ActiveWorkbook.Sheets("MAIN").Paste
End Sub

С одно стороны все логично и должно работать. И даже работает, но не всегда - ошибка все равно появлялась чуть ли не в половине случаев. Почему? Потому что дело все же в некорректной работе буфера. И DoEvents хоть и передавал управление - проблемы вовсе не решал. Он просто давал небольшую отсрочку, которая позволяла в ряде случаев картинке догрузиться в буфер и избежать ошибки. Но главная проблема в том, что неизвестно для какого ПК сколько таких циклов надо, потому что неизвестно сколько ждать до полной загрузки картинки в буфер. Неизвестно, т.к. на каждом ПК это может быть разное время. В итоге, помучившись еще какое-то время я нашел "костыльное" решение проблемы через такой код:

Sub CopyPastePicture()
    'сначала очистим буфер, чтобы там точно ничего лишнего не было
    Application.CutCopyMode = False
    'копируем картинку
    ActiveWorkbook.Sheets("PICS").Shapes("Picture1").Copy
    'а теперь разрешаем пропуск всех ошибок!
    On Error Resume Next
    Err.Clear 'очищаем лог ошибок, если они были
    'пробуем вставить нашу картинку
    ActiveWorkbook.Sheets("MAIN").Paste
    'если в момент вставки возникла ошибка
    '    сработает цикл, который будет выполняться до тех пор,
    '    пока что-то все же не вставится
    Do While Err.Number <> 0
        Err.Clear
        ActiveWorkbook.Sheets("MAIN").Paste
        'передаем управление системе
        DoEvents
    Loop
    'отключаем пропуск ошибок
    On Error GoTo 0
    'опять очищаем буфер - теперь уже от того, что скопировали сами кодом
    Application.CutCopyMode = False
End Sub

Решение основано на том, что мы сначала копируем картинку, а потом пробуем её вставить. Если возникает ошибка - запускаем цикл, в котором пытаемся вставить картинку из буфера до тех пор, пока она все же не будет вставлена. Т.е. пока ошибка возникает - картинка не прогрузилась и цикл работает. Как только картинка прогрузилась в буфер - она вставляется без ошибки и цикл завершается.
И такой подход работает и по скорости не сильно тормозит процесс. Единственное, что неплохо было бы добавить - так это некий счетчик. Вдруг по какой-то причин буфер вообще очистился(ну бывают системные ошибки) или ошибка возникала совсем по другой причине(например, вставка производится на защищенный лист) - тогда получим бесконечный цикл. В этом случае лучше всего код "обернуть" в функцию:

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          http://www.excel-vba.ru
'          info@excel-vba.ru
' Purpose: Копирует указанную картинку и вставляет на заданный лист
'          oCopy    - картинка, для вставки на лист
'          wsPaste  - лист, на который необходимо вставить картинку
'---------------------------------------------------------------------------------------
Function CopyPastePicture(oCopy As Shape, wsPaste As Worksheet)
    Dim lPasteCnt As Long 'счетчик вставок
    'сначала очистим буфер, чтобы там точно ничего лишнего не было
    Application.CutCopyMode = False
    'копируем картинку
    oCopy.Copy
    'а теперь разрешаем пропуск всех ошибок!
    On Error Resume Next
    Err.Clear 'очищаем лог ошибок, если они были
    'пробуем вставить нашу картинку
    wsPaste.Paste
    'если в момент вставки возникла ошибка
    '    сработает цикл, который будет выполняться до тех пор,
    '    пока что-то все же не вставиться
    Do While Err.Number <> 0
        Err.Clear
        wsPaste.Paste
        'передаем управление системе
        DoEvents
        'сччитаем кол-во вставок
        lPasteCnt = lPasteCnt + 1
        'если уже более 1000 вставок сделали
        '  но ошибка не уходит - принудительно завершаем цикл
        '  ошибка при этом будет не нулевой
        If lPasteCnt > 1000 Then
            Exit Do
        End If
    Loop
    'если вставка прошла успешно - ошибка будет нулевой
    CopyPastePicture = (Err.Number = 0)
    'отключаем пропуск ошибок
    On Error GoTo 0
    'опять очищаем буфер - теперь уже от того, что скопировали сами кодом
    Application.CutCopyMode = False
End Function

тогда можно будет не только вставить картинку, но и получить обратную связь - успешно прошла вставка или нет. Если кажется, что 1000 попыток это много, то можно просто в строке If lPasteCnt > 1000 Then вместо 1000 указать нужное число.
А использовать приведенную функцию можно будет так:

Sub TryPastePicture()
    If CopyPastePicture(ActiveWorkbook.Sheets("PICS").Shapes("Picture1"), ActiveWorkbook.Sheets("MAIN")) = False Then
        MsgBox "Не удалось вставить картинку", vbInformation, "www.excel-vba.ru"
        Exit Sub
    End If
End Sub

Т.е. мы вызываем функцию, которая пробует вставить картинку. Если все 1000 попыток были безуспешными, то функция вернет значение False. Если же хоть одна вставка удалась - функция вернет True.
Кстати, функция поможет сделать вставку не только картинки, но и любой другой фигуры, у которой есть метод Copy: рисунок, фигура, диаграмма.

Если тоже столкнулись с такой проблемой - делитесь в комментариях кто как решал и что помогло. Соберем подборку методов :)


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти