Слияние нескольких рабочих листов с изображениями в одну книгу - Ошибка изображения

Question

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

Далее следует код я использую:

Sub MergePlans() 
Dim CurFile As String, DirLoc As String 
Dim DestWB As Workbook 
Dim ws As Object 

DirLoc = ThisWorkbook.Path & "\Merge\" 
CurFile = Dir(DirLoc & "*.xlsx") 

Application.ScreenUpdating = False 
Application.EnableEvents = False 

Set DestWB = Workbooks.Add(xlWorksheet) 

Do While CurFile <> vbNullString 
    Dim OrigWB As Workbook 
    Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True) 

    For Each ws In OrigWB.Sheets 
     ws.Select 
     ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count) 
    Next 

    OrigWB.Close Savechanges:=False 
    CurFile = Dir 
Loop 

Application.DisplayAlerts = False 
DestWB.Sheets(1).Delete 
Application.DisplayAlerts = True 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

Set DestWB = Nothing 

End Sub 

Любая идея о том, что происходит? Буду признателен за любую помощь! Tks!

Answer 1

только что нашел обходное решение, которое помогло!

Я только что добавил «Application.ScreenUpdating = True» перед закрытием исходной книги, для слияния всех таблиц требуется больше времени, но, по крайней мере, изображения отображаются правильно!

Здесь следует новый код:

Sub MergePlans() 
Dim CurFile As String, DirLoc As String 
Dim DestWB As Workbook 
Dim ws As Object 

DirLoc = ThisWorkbook.Path & "\Merge\" 
CurFile = Dir(DirLoc & "*.xlsx") 

Application.ScreenUpdating = False 
Application.EnableEvents = False 

Set DestWB = Workbooks.Add(xlWorksheet) 

Do While CurFile <> vbNullString 
    Dim OrigWB As Workbook 
    Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True) 

    For Each ws In OrigWB.Sheets 
     ws.Select 
     ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count) 
    Next 
    **Application.ScreenUpdating = True** 
    OrigWB.Close Savechanges:=False 
    CurFile = Dir 
Loop 

Application.DisplayAlerts = False 
DestWB.Sheets(1).Delete 
Application.DisplayAlerts = True 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

Set DestWB = Nothing 


End Sub 

Найдено этот способ here - Вариант 1!

Tks Dan!