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

Question

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

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

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

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

Редактировать: code.

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