Vba 无法使用宏将数据从Excel复制到PPT

我有一个宏，基本上是复制excel电子表格中的范围，然后将它们粘贴到powerpoint文件中。因此，每张幻灯片一张excel表格

以下是我迄今为止的宏：

    Option Explicit

    Sub ExportToPPT()
     Dim PPAPP As PowerPoint.Application
    Dim PPRES As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim ppSRng As PowerPoint.ShapeRange

    Dim XLAPP As Excel.Application
    Dim XLwbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Dim XLRng As Excel.Range

    Dim ppPathFile As String
    Dim ppNewPathFile

    Dim chartNum As Integer
    Dim maxCharts As Integer

    Debug.Print vbCrLf & "    ---- EXPORT EXCEL RANGES POWERPOINT ----"
    Debug.Print Now() & " - Exporting ranges to .ppt"

    'CHANGE WHEN ADDING CHARTS - MUST ALSO ADD SLIDE to .PPT and change loop
    Dim chartRng(1 To 9) As Excel.Range
    Dim SlideNum As Integer
    Dim SlideOffset As Integer

    Set XLwbk = Excel.ActiveWorkbook
    Set xlWst = XLwbk.Sheets("Test1")

        'This accounts for the title slide and any others before the automatedpaste
        SlideOffset = 1
        Set chartRng(1) = XLwbk.Sheets("Test1").Range("A1:B15")
        Set chartRng(2) = XLwbk.Sheets("Test2").Range("A1:E33")
        Set chartRng(3) = XLwbk.Sheets("Test3").Range("A1:E33")
        Set chartRng(4) = XLwbk.Sheets("Test4").Range("A1:E4")
        Set chartRng(5) = XLwbk.Sheets("Test5").Range("A1:J14")
        Set chartRng(6) = XLwbk.Sheets("Test6").Range("A1:I33")
        Set chartRng(7) = XLwbk.Sheets("Test7").Range("A1:I11")
        Set chartRng(8) = XLwbk.Sheets("Test8").Range("A1:I8")


    ' Create instance of PowerPoint
    Set PPAPP = CreateObject("Powerpoint.Application")
        PPAPP.Visible = True

        ' Open the presentation (Same folder as the Excel file)
        ppPathFile = ActiveWorkbook.Path + "TestPPT.pptx"
        Debug.Print ppPathFile
        Set PPRES = PPAPP.Presentations.Open(ppPathFile)

        PPAPP.ActiveWindow.ViewType = ppViewSlide


    chartNum = 1

    'Loop through all chart ranges
    'CHANGE WHEN ADDING CHARTS
    For chartNum = 1 To 9
        SlideNum = chartNum + SlideOffset
        Debug.Print "Chart number " & chartNum & " to slide number " & SlideNum

        ' Copy the range as a picture
         chartRng(chartNum).CopyPicture Appearance:=xlScreen, Format:=xlPicture


        'PowerPoint operations
           Set PPSlide = PPAPP.ActivePresentation.AddSlide(1, _ **//New code**
PPAPP.ActivePresentation.SlideMaster.CustomLayouts.Item(2))
            Debug.Print PPSlide.Name
            PPSlide.Select

            PPAPP.ActiveWindow.ViewType = ppViewSlide
            'ppapp.ActivePresentation.Slides.
            ' Paste the range
            'PPAPP.ActiveWindow.View.Slide (SlideNum)
            PPAPP.ActiveWindow.View.Paste

            'PPSlide.Shapes.Paste
            'PPSlide.Shapes(0).Select
            'PPSlide.Shapes.Paste.Select

                ' Align the pasted range
                Set ppSRng = PPAPP.ActiveWindow.Selection.ShapeRange
                With ppSRng
                    .LockAspectRatio = msoTrue
                If (.Width / .Height) > 1.65 Then
                        .Width = 650
                    Else
                        .Height = 400
                    End If
                End With


                With ppSRng
                    '.Width = 650
                    .Align msoAlignCenters, True
                    .Align msoAlignMiddles, True
                    .IncrementTop 1.5
                End With

    Next chartNum

    PPAPP.ActivePresentation.Slides(1).Select
    PPAPP.ActiveWindow.ViewType = ppViewNormal
    PPAPP.Activate

    ppNewPathFile = ActiveWorkbook.Path & "\Test\TestPPT.pptx" & Format(Now(), "yyyymmdd_hhmmss")
    PPAPP.ActivePresentation.SaveAs ppNewPathFile, ppSaveAsDefault

    Debug.Print Now() & " - Finished"

    End Sub

当我运行宏时，它会打开PowerPoint，但会停止，并出现以下错误：

当我调试时，它会停在这一行：

Set PPSlide = PPAPP.ActivePresentation.Slides(SlideNum)

---

任何关于如何解决这一问题的帮助都是非常好的。该错误指向您在代码中引入的一个计数问题。显然，在第一次迭代中，它试图选择一张幻灯片演示文稿的第二张幻灯片（第二张幻灯片不存在）并抛出错误

我假设发生这种情况是因为您的

SlideOffset

变量。首先考虑在运行<代码>之前添加一个幻灯片> SETPP幻灯片= PPAP。ActudioPrime.幻灯片（SlideNum）。大概是这样的：

Set pptLayout = PPAPP.ActivePresentation.Slides(1).CustomLayout 
Set pptSlide = PPAPP.ActivePresentation.Slides.AddSlide(2, pptLayout)

试试这个

Set PPSlide = PPAPP.ActivePresentation.AddSlide(1,  _
PPAPP.ActivePresentation.SlideMaster.CustomLayouts.Item(2))

---

我需要先声明CustomLayout变量吗？尝试为PowerPoint查找该属性，但该属性不可用。代码取自此处。它确实首先声明了

CustomLayout

变量，但通常只有在声明了

选项Explicit On

时才需要这样做，所以您需要修改它以将

Dim pptLayout包含为CustomLayout

我在该行得到编译错误，表示参数不是可选的。有什么想法吗？现在我得到了一个错误，即在“AddSlide”上找不到方法或数据成员。我编辑了上面的代码以显示更改。打开一个空的power point文件，将此代码复制到其中：调用Presentations.Item（1）。Slides.AddSlide（1，Presentations.Item（1）。SlideMaster.CustomLayouts.Item（1））很好，现在将其放入您的代码中。如果您仍然遇到问题，您可以通过电子邮件将文件发送给我，我将查看这些文件。我们能够编写一些新代码，但我需要有关格式的其他帮助。如果可以，我会向您发送电子邮件。非常感谢。