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！

丹克斯！

将带有Images的多个工作表合并到一个工作簿中 - 图像错误

1 个答案: