Question

我有一个宏，基本上应该从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但停止并出现以下错误：

enter image description here

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

Set PPSlide = PPAPP.ActivePresentation.Slides(SlideNum)

如何解决这个问题的任何帮助都会很棒。

Answer 1

错误指向您在代码中引入的计数问题。显然，在第一次迭代期间，它会尝试选择单幻灯片演示文稿的第二张幻灯片（第二张幻灯片不存在）并抛出错误。

我认为这是因为你的SlideOffset变量。首先考虑在运行Set PPSlide = PPAPP.ActivePresentation.Slides(SlideNum)之前添加幻灯片。像这样：

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

Answer 2

尝试使用此

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

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

2 个答案: