使用macros复制图像与工作表
我在VBA中编写了一个macros，它打开了另一个工作簿，并将工作表复制到活动工作簿中，然后再次closures工作表。
这一切工作正常，但工作表中包含的图像不复制。 我得到一个占位符，图像应该是，显示文本“此图像目前不能显示”。
当我手动执行相同的程序时，图像将不会出现问题。
为什么会发生这种情况，我该怎么办才能解决这个问题？
编辑：下面的代码。
Sub copy_sheet() Dim wbk_current As Workbook Set wbk_current = ActiveWorkbook Application.ScreenUpdating = False Application.DisplayAlerts = False Dim lastdate As String, filename As String lastdate = Format(wbk_current.Worksheets(1).Range("D11") - 7, "ddmmyy") filename = "C:\Folder\Filename " & lastdate & ".xlsx" Dim wbk_old As Workbook Set wbk_old = Workbooks.Open(filename) wbk_old.Worksheets(2).Copy after:=wbk_current.Worksheets(1) wbk_old.Close Dim lastrow As Integer lastrow = wbk_current.Worksheets(2).UsedRange.Rows.Count weekrange = Format(wbk_current.Worksheets(1).Range("C11"), "dd/mm/yy") & " - " & Format(wbk_current.Worksheets(1).Range("D11"), "dd/mm/yy") wbk_current.Worksheets(2).Rows(lastrow - 1 & ":" & lastrow - 1).Copy wbk_current.Worksheets(2).Rows(lastrow & ":" & lastrow).Insert shift:=xlDown wbk_current.Worksheets(2).Range("B" & lastrow).Value = wbk_current.Worksheets(2).Range("B" & lastrow - 1).Value + 1 wbk_current.Worksheets(2).Range("C" & lastrow) = weekrange wbk_current.Worksheets(2).Range("D" & lastrow & ":J" & lastrow).Value = wbk_current.Worksheets(1).Range("C16:I16").Value Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub （前15行是相关的。）
据我所知，这应该做手动完成相同的事情 – 我正在复制工作表本身，而不是内容。 当我手动做图像传输很好。 当我运行这个macros时，它确实会提取一些东西 – 但是不是显示图像，而是看起来像是图像加载失败时在网页上可能会出现的错误。
一个较老的问题，但因为似乎还没有答案，因为我刚刚遇到了同样的问题：解决scheme很容易，虽然它有明显的其他缺点。
如果ScreenUpdating设置为False Excel似乎无法复制图片，因此在复制工作表之前，请不要停用ScreenUpdating或重新激活它。
我不完全确定背后的原因。
尝试使用这个作为指导操纵你的代码;
Private Sub Worksheet_Change(ByVal Target As Range) Dim picName As String If Target.Column = 2 And Target.Row >= 5 Then picName = Target.Value Copy_Images picName End If End Sub Private Sub Copy_Images(imageName As String) Dim sh As Shape For Each sh In Sheets(2).Shapes If sh.Name = imageName Then sh.Copy Sheets(1).Pictures.Paste End If Next End Sub