Question

我在VBA中编写了一个宏，它打开另一个工作簿并将工作表复制到活动工作簿中，然后再次关闭工作表。

这一切都正常，但工作表中包含的图像不会复制。我得到一个占位符，图像应该是，显示文本＆＃34;此图像当前无法显示＆＃34;。

当我手动执行相同的步骤时，图像会复制而不会出现问题。

为什么会发生这种情况，我该怎么做才能解决它？

编辑：以下代码。

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行左右是相关的。）

据我所知，这应该与手动操作完全相同 - 我复制工作表本身而不是内容。当我手动执行此操作时，图像传输正常。当我运行宏时，它确实选择某些东西 - 但不是显示图像，而是看起来当图像无法加载时你可能会在网页上出现错误。

Answer 1

一个较旧的问题，但由于似乎还没有答案，因为我遇到了同样的问题：解决方案非常简单，尽管它有明显的其他缺点。

如果ScreenUpdating设置为False Excel似乎无法复制图片，那么要么根本不要停用ScreenUpdating，要么在复制工作表之前重新激活它。

Answer 2

我不完全确定为什么会发生这种情况的原因。

尝试使用此作为指导来操纵您的代码;

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

使用宏复制带工作表的图像

2 个答案: