0

こんにちは、エクセルからパワーポイントに画像をコピーしようとしています。私のコードは既にコピーして 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
4

1 に答える 1

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
于 2014-03-18T21:47:45.090 に答える