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

Question

I am using the following code to put together a Powerpoint presentation from many other powerpoint presentations:

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

In the excel file in column "K" are the names of the source ppts, and in column "L" are the slide numbers it needs to copy. However I get an error message when the macro gets to a line where the number in column "L" is above 26 (meaning that the slide needed is above 26 in the source ppt)

Could anyone help with this?

Also I am looking for a simple macro that can similarly to the above can copy given pages of a pdf file to another pdf file while also giving where exactly ( page number ) to copy.

Answer 1

I've not had a chance to test it, but this code should copy a number of slides from a Source presentation to a Destination presentation.

It will error out if given invalid numbers (such as "copy 0 slides" ), and will automatically adjust for overflow (eg "Copy slides 1 to 10 of 7 slides" or "insert at slide 20 of 15" ) - both of which I think are errors you may be having.

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