Excel VBA-код для перемещения листов с обновлением экрана изображения и ошибок

У меня есть макрос Excel 2010, который открывает все книги в данной папке и перемещает Sheet1 из новых книг в рабочую книгу мастера, которая работает, но очень медленная. Сегодня я обновил его, включив Application.ScreenUpdating = False чтобы сократить время обработки. На листе 1 есть логотип, а с обновлением экрана логотип теперь показывает следующую ошибку:

«Это изображение в настоящее время не отображается».

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

Ниже приведена упрощенная версия кода, который я использую, который все еще вызывает ошибку:

 Sub GetSheets() Application.DisplayAlerts = False Application.ScreenUpdating = False Path = "G:\Project Dashboards\Testing Folder\" Filename = Dir(Path & "*.xls") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, UpdateLinks:=True, ReadOnly:=True Workbooks(Filename).Activate Sheets(1).Move after:=ThisWorkbook.Sheets(1) ActiveSheet.Name = ActiveSheet.Cells(2, 17).Value Workbooks(Filename).Close False Filename = Dir() Loop ActiveWorkbook.Save Application.ScreenUpdating = True End Sub 

Если вы закомментируете Application.ScreenUpdating = False изображение будет перемещено с рабочим листом по желанию.

Хорошо, поэтому я не знаю точной причины (извините – я еще не видел объяснений), но я знаю, что в 2010 году это проблема. Я знаю о двух возможных обходных решениях:

1) вы можете попытаться не закрывать исходные книги до тех пор, пока вы не включите обновление экрана. Это для меня кажется немного грубым грузом, поскольку я не знаю точного механизма, почему это работает. Кроме того, IIRC я ​​не думаю, что он работает с изображениями, вставленными в качестве ссылок.
2) вы можете попробовать использовать Range.Copy, который должен работать с любым изображением


Примеры кода:

Примеры кода полностью непроверены
Опция 1:

 Sub GetSheets() Application.DisplayAlerts = False Application.ScreenUpdating = False Path = "G:\Project Dashboards\Testing Folder\" Filename = Dir(Path & "*.xls") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, UpdateLinks:=True, ReadOnly:=True Workbooks(Filename).Activate Sheets(1).Move (after:=ThisWorkbook.Sheets(1)).Name = ActiveSheet.Cells(2, 17).Value 'Workbooks(Filename).Close False Filename = Dir() Loop ThisWorkbook.Save Application.ScreenUpdating = True Dim Book as Workbook For Each Book in Workbooks If Not Book Is ThisWorkbook then Book.Close False Next End Sub 

вариант 2:

 Sub GetSheets() Application.DisplayAlerts = False Application.ScreenUpdating = False Path = "G:\Project Dashboards\Testing Folder\" Dim SourceBook as Workbook Dim TargetBook as Workbook Dim OldSheet as Worksheet Dim NewSheet as Worksheet Filename = Dir(Path & "*.xls") Do While Filename <> "" Set TargetBook=ThisWorkbook Set Sourcebook=Workbooks.Open Filename:=Path & Filename, UpdateLinks:=True, ReadOnly:=True 'Workbooks(Filename).Activate Set OldSheet=Sourcebook.Sheets(1) Set NewSheet=TargetBook.Worksheets.Add (After:=TargetBook.Sheets(1)) NewSheet.Name = OldSheet.Cells(2, 17).Value OldSheet.Cells.Copy Destination:=NewSheet.Cells(1,1) Sourcebook.Close False Filename = Dir() Loop TargetBook.Save 'I assumed you wanted to save the workbook you added sheets to Application.ScreenUpdating = True End Sub 
Interesting Posts

Данные свертываются вместе с транспозицией

Каждый третий столбец, связанный друг с другом

Макрос PDF, но файлы не обновляются на диске

VBA Перемещение изображений на новые рабочие листы в том же месте

Excel Userform застрял в .show

Не удалось записать несколько значений в excel из Java-кода

Сопоставьте столбцы в двух разных листах и ​​верните несколько столбцов

Excel Поиск и втягивание в зависимости от содержимого ячейки

Excel Macro добавит новую строку

Вставка, обновление, удаление данных из и для Excel с использованием соединения oled или odbc

Используйте формулу Excel в Crystal, затем экспортируйте отчет в Excel

Удалите пробелы в VBA excel

Не удается добавить данные в таблицу MySQL при перемещении данных из excel в workbench MySQL

макрос для автоматического добавления строк в excel

Ошибка IRibbonUI.invalidate с пользовательской лентой Excel 2010 с исключением COM 0x80004005 … иногда

Давайте будем гением компьютера.