VBA - Powerpoint 演示文稿（和 PDF）合并答案

【问题标题】：VBA - Powerpoint presentation ( and PDF) mergingVBA - Powerpoint 演示文稿（和 PDF）合并
【发布时间】：2020-07-12 05:56:08
【问题描述】：

我正在使用以下代码将来自许多其他 powerpoint 演示文稿的 Powerpoint 演示文稿放在一起：

Sub InsertFromOtherPres()
    Dim xlApp As Object
    Dim xlWorkBook As Object
    Dim i, j As Byte
    Dim wbname As String
    Dim sldB, sldE As Byte

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    On Error Resume Next

    Set xlWorkBook = xlApp.Workbooks.Open("C:\Users\----\OneDrive\Desktop\Roli PPT\Book - Pages - Macro.xlsm", True, False)

    On Error GoTo 0

    j = 3

    For i = 2 To 154
        wbname = "C:\Users\----\OneDrive\Desktop\Roli PPT\" & xlWorkBook.Sheets("Sheet1").Cells(i, "K").Value

        sldB = xlWorkBook.Sheets("Sheet1").Cells(i, "L").Value
        sldE = xlWorkBook.Sheets("Sheet1").Cells(i, "L").Value

        ActivePresentation.Slides.InsertFromFile FileName:=wbname, Index:=j, SlideStart:=sldB, SlideEnd:=sldE

        j = j + 1
    Next i

    Set xlApp = Nothing
    Set xlWorkBook = Nothing

    MsgBox "Ready"
End Sub

在excel文件中，“K”列是源ppts的名称，“L”列是它需要复制的幻灯片编号。但是，当宏到达“L”列中的数字高于 26 的行时，我收到一条错误消息（意味着所需的幻灯片在源 ppt 中高于 26）

有人可以帮忙吗？

另外，我正在寻找一个简单的宏，它可以类似于上面的内容，可以将 pdf 文件的给定页面复制到另一个 pdf 文件，同时还可以给出确切的复制位置（页码）。

【问题讨论】：

报错时你有没有使用Debug.Print检查j的值？
（可能也值得检查 sldB 和 sldE 的值）另外 - 尽量坚持每个问题只提出一个具体和集中的问题
对于您的 PDF 程序集，您可以使用 Acrobat 中的 JavaScript 来完成。 pdfscripting.com 还有不少第三方 PDF 库可以让您编写各种语言的 PDF 汇编脚本。这是我用过的一个：appligent.com/server-software/appendpdf-pro

标签： vba pdf powerpoint

【解决方案1】：

我还没有机会对其进行测试，但此代码应该将多个幻灯片从 Source 演示文稿复制到 Destination 演示文稿。

如果给定的数字无效（例如“复制0张幻灯片”）会出错，并且会自动调整溢出（例如“复制7张幻灯片中的1到10张幻灯片” 或 "insert at slide 20 of 15") - 我认为这两个都是您可能遇到的错误。

Private Function CopySlidesToPresentation(ByRef Source As Presentation, ByVal CopyStart As Long, ByVal CopySlides As Long, _
    ByRef Destination As Presentation, Optional ByVal InsertAt As Long = -1) As Boolean
    'Source: Presentation to copy from
    'CopyStart: First slide to copy
    'CopySlides: How many slides to copy
    'Destination: Presentation to copy to
    '~~OPTIONAL~~
    'InsertAt: Position to insert at.  If omitted, will insert at the end of the Presentation
    '~~RETURNS~~
    'TRUE if all slides copy successfully
    'FALSE if unable to copy slides

    Dim CurrentSlide As Long

    CopySlidesToPresentation = False
    If CopyStart < 1 Then Exit Function 'Cannot start before the First Slide
    If CopySlides < 1 Then Exit Function 'Cannot copy No or Negative Slides
    If CopyStart > Source.Slides.Count Then Exit Function 'Cannot copy after the Last Slide
    If InsertAt < 1 Then Exit Function 'Cannot Insert before the Presentation starts

    If CopyStart + CopySlides > Source.Slides.Count Then CopySlides = 1 + Source.Slides.Count - CopyStart 'Trim to Presentation Length
    If InsertAt > Destination.Slides.Count Then InsertAt = -1 'Trim to Presentation Length

    On Error GoTo FunctionError

    For CurrentSlide = 0 To CopySlides - 1 'Copy each slide in turn
        Source.Slides(CopyStart + CurrentSlide).Copy
        If InsertAt > 0 Then
            Destination.Slides.Paste InsertAt + CurrentSlide
        Else
            Destination.Slides.Paste 'Put it at the end
        End If
    Next CurrentSlide

    CopySlidesToPresentation = True 'Success!

FunctionError:
    On Error GoTo -1 'Clear the Error Handler
End Function

【讨论】：