Excel to Powerpoint：调整图像大小

Question

Hello I am try to copy an image from excel into powerpoint. My code already copy and pastes into excel but I am having an issue with the code that would automate the resizing. With this current code I get object required Runtime error 424. Any help would be appreciated. MY abbreviated code is below.

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

This (a simplified version of your code) works fine for me:

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