파워 포인트로 엑셀 : 문제 이미지 크기 조정

Question

안녕하세요 저는 엑셀에서 이미지를 파워 포인트로 복사하려고합니다. 내 코드는 이미 복사 및 붙여 넣기를 Excel로하지만 크기를 자동으로 조정하는 코드에 문제가 있습니다. 이 현재 코드를 사용하면 객체에 런타임 오류 424가 필요합니다. 어떤 도움을 주시면 감사하겠습니다. 내 단축 코드는 다음과 같습니다.

Sub CopyDataToPPT() 
'Const ppLayoutBlank = 12 
Dim objWorkSheet As Worksheet 
Dim objRange As Range 
Dim objPPT As PowerPoint.Application 
Dim objPresentation As Presentation 
Dim shapePPTOne As Object 
Dim intLocation As Integer 
Dim intHeight As Integer 
Dim inLayout As Integer 
Dim strRange As String 
Dim boolOK As Boolean 
Set objPPT = CreateObject("PowerPoint.Application") 
Set objPresentation = objPPT.Presentations.Add 

'First 1 Xor 2 charts 
    If Sheets("Summary Table").Cells(15, 4) <> "Not Found" Then 
     strRange = "B4:N24" 
     intHeight = 380 
    Else 
     strRange = "B4:N13" 
     intHeight = 190 
    End If 

    Set objslide = objPresentation.Slides.Add(1, inLayout) 
    objPresentation.Slides(1).Layout = ppLayoutTitleOnly 

    objPresentation.Slides(1).Shapes.Title.TextFrame.TextRange.Text = Sheets("Summary Table").Cells(2, 5) & " - " & Sheets("Summary Table").Cells(4, 2) 
    Set objRange = Sheets("Summary Table").Range(strRange) 
    objRange.Copy 

    DoEvents 
    Set shapePPTOne = objslide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile, Link:=msoFalse) 

    shapePPTOne.Height = intHeight 
    shapePPTOne.Left = 50 
    shapePPTOne.Top = 100 

    Application.CutCopyMode = False 
Next intLocation 

Answer 1

이 (코드의 단순화 된 버전) 나를 위해 잘 작동 :

이

Sub CopyDataToPPT() 

Dim objslide 
Dim objRange As Range 
Dim objPPT As PowerPoint.Application 
Dim objPresentation As Presentation 
Dim shapePPTOne As Object 


    Set objPPT = CreateObject("PowerPoint.Application") 
    Set objPresentation = objPPT.Presentations.Add 

    Set objslide = objPresentation.Slides.Add(1, ppLayoutTitleOnly) 'you had inLayout??? 
    objslide.Shapes.Title.TextFrame.TextRange.Text = "blah blah" 

    Sheets("Sheet1").Range("C6:G22").Copy 
    DoEvents 

    Set shapePPTOne = objslide.Shapes.PasteSpecial(_ 
       DataType:=ppPasteEnhancedMetafile, Link:=msoFalse) 

    With shapePPTOne 
     .Height = 200 
     .Left = 50 
     .Top = 100 
    End With 

    Application.CutCopyMode = False 

End Sub