[英]VBA - Powerpoint presentation ( and PDF) merging
我正在使用以下代碼將許多其他 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”列是源ppt的名稱,“L”列是需要復制的幻燈片編號。 但是,當宏到達“L”列中的數字高於 26 的行時,我收到一條錯誤消息(意味着所需的幻燈片在源 ppt 中高於 26)
有人可以幫忙嗎?
此外,我正在尋找一個簡單的宏,它可以與上述類似,可以將 pdf 文件的給定頁面復制到另一個 pdf 文件,同時還給出要復制的確切位置(頁碼)。
我還沒有機會測試它,但是這段代碼應該將一些幻燈片從Source
演示文稿復制到Destination
演示文稿。
如果給出無效數字(例如“復制 0 張幻燈片” ),它會出錯,並且會自動調整溢出(例如“將幻燈片 1 復制到 7 張幻燈片中的 10”或“插入幻燈片 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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.