如何将Excel中的图表复制并粘贴到PowerPoint中的占位符中？

我在工作簿中的每张工作表上都有2个图表，我想在每张幻灯片的占位符上复制2个图表。代码现在继续创建新的PowerPoint，而不是使用我打开的模板。我有以下代码

Sub CopyPasteCharts()

MsgBox "Select the file you have generated.", vbInformation + vbOKOnly

Dim fNameAndPath As Variant, wb As Workbook
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")

If fNameAndPath = False Then Exit Sub

Set wb = Workbooks.Open(fNameAndPath)
wb.Activate

Dim ppt As PowerPoint.Application
Dim ppTPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
Dim pptCL As PowerPoint.CustomLayout
Dim pptShp As PowerPoint.Shape

Dim chtt As Chart
Dim ws As Worksheet
Dim i As Long

'Optimise execution of code
Application.ScreenUpdating = False

'Get the PowerPoint Application object:
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = msoTrue
'Set ppTPres = ppt.Presentations.Add

'Get a Custom Layout:
For Each pptCL In ppTPres.SlideMaster.CustomLayouts
    If pptCL.Name = "Title and Content" Then Exit For
Next pptCL

'Copy ALL charts embedded in EACH WorkSheet:
For Each ws In ActiveWorkbook.Worksheets

    Set pptSld = ppTPres.Slides.AddSlide(ppTPres.Slides.Count + 1, pptCL)
    pptSld.Select

    For i = 1 To ws.ChartObjects.Count

        For Each pptShp In pptSld.Shapes.Placeholders
            If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
        Next pptShp

        Set chtt = ws.ChartObjects(i).Chart

        chtt.ChartArea.Copy

        ppt.Activate
        pptShp.Select
        ppt.Windows(1).View.Paste

    Next i
Next ws

'Optimise execution of code
Set chtt = Nothing
Set pptSld = Nothing
Application.ScreenUpdating = True

'Clear clipboard
Application.CutCopyMode = False
End Sub

[编辑]

我已经更改了代码，但是没有。在

ActiveWorkbook.Worksheets（“图表1”）.ChartObjects（1）.Activate.ChartArea.Copy处发生下标超出范围的情况

新代码：

'获取文件

fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")

If fNameAndPath = False Then Exit Sub

Set wb = Workbooks.Open(fNameAndPath)
wb.Activate

Dim obPptApp As PowerPoint.Application
Dim OpenPptDialogBox As Object
Dim MyChart As Chart
Dim MyShape As Object

Set obPptApp = CreateObject("PowerPoint.Application")
Set OpenPptDialogBox = obPptApp.FileDialog(msoFileDialogOpen)

'Open the target PPT using dialog box
If OpenPptDialogBox.Show = -1 Then
obPptApp.Presentations.Open (OpenPptDialogBox.SelectedItems(1))
End If

'Copy the chart from excel macro file

ActiveWorkbook.Worksheets("Chart 1").ChartObjects(1).Activate.ChartArea.Copy

'Paste the chart in  slide 1 of PPT
 Set MyShape = obPptApp.ActiveWindow.Presentation.Slides(1).Shapes.Paste

尚未对其进行测试，但可能会有所帮助。
'Set ppTPres=ppt.Presentations.Add
是否应该打开相关的powerpoint文件？如果您正在使用开放式演示文稿，那么您需要参考它吗？我看不到您的
ppTPres
对象正在初始化？