大的問題,我想這個很長一段時間做自己,所以走上弄清楚你的時間(和我!)。
基本上,你會通過所有NamedSlideShows
想要一個)循環,b)通過SlideID
找到他們的幻燈片,c)加入新的演示文稿,然後d)複製在NamedSlideShow
幻燈片與原設計。您可以根據您在命令中發送的方式爲一個或全部自定義節目執行此操作。
下面是一個例子:
Sub FindShows()
Dim p As PowerPoint.Presentation
Set p = PowerPoint.ActivePresenation
Dim cShow As PowerPoint.NamedSlideShow
For Each cShow In p.SlideShowSettings.NamedSlideShows
SaveCustomShow (cShow.Name, p)
'If using PowerPoint 2010 use the following line instead:
'SaveCustomShow cShow.Name, p
Next
End Sub
的FindShows
子剛剛找到所有的自定義顯示在ActivePresentation
,並將它們發送到將創建一個基於指定的自定義放映的名稱每個新presenation的例程。您可以根據需要進行自定義。
下面的例程是它的核心。有幾件事情需要注意:
- 要通過 源滑動的滑蓋設計派,你必須設置複製幻燈片使用 設計明確地 。
- A
NamedSlideShow
只會給你 其中的幻燈片SlideID
。 您可以使用FindBySlideID
然後 確定幻燈片中原始的 演示文稿 - 它返回幻燈片 對象。然後你只需複製它,並 粘貼它的原始設計 。
Sub SaveCustomShow(showName As String, p As Presentation)
Dim cShows As PowerPoint.NamedSlideShows
Set cShows = p.SlideShowSettings.NamedSlideShows
Dim cSlideIDs As Variant
cSlideIDs = cShows(showName).SlideIDs
Dim destinationPath As String
destinationPath = "C:\Temp\"
Dim newP As PowerPoint.Presentation
Set newP = PowerPoint.Presentations.Add(WithWindow:=False)
With newP
.SaveAs destinationPath & cShows(showName).Name
Dim s As PowerPoint.Slide
Dim e As Integer
For e = 1 To UBound(cSlideIDs)
Set s = p.Slides.FindBySlideID(SlideID:=cSlideIDs(e))
s.Copy
.Slides.Paste.Design = s.Design
Next
.Save
.Close
End With
Set newP = Nothing
End Sub
這裏沒有任何錯誤代碼檢查,這樣就需要被制定出來,但它就像一個魅力!