Копирование изображения с помощью рабочего листа с использованием макроса

Я написал макрос в VBA, который открывает другую книгу и копирует рабочий лист в активную книгу, а затем снова закрывает рабочий лист.

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

Когда я делаю ту же процедуру вручную, изображения копируются без проблем.

Почему это происходит, и что я могу сделать, чтобы исправить это?

Изменение: код ниже.

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 или около того строк являются релевантными).

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

2 ответа

Более старый вопрос, но поскольку ответа пока нет, и поскольку я столкнулся с одной и той же проблемой: решение довольно простое, хотя оно имеет и другие недостатки.

Если для параметра 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

licensed under cc by-sa 3.0 with attribution.