매크로를 사용하여 워크 시트로 이미지 복사

Question

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 정도 선은 관련 것들입니다.)

는

는 지금까지 내가 알고 있어요,이 수동으로 그 일을 정확히 같은 일을한다 - 나는 시트를 복사하는거야 그 자체보다는 내용. 수동으로하면 이미지가 잘 전송됩니다. 매크로를 실행하면 무언가이 표시되지만 이미지를 표시하는 대신 이미지로드에 실패 할 때 웹 페이지에 표시되는 오류와 유사합니다.

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