큰 문제는, 내가 오랜 시간 동안이 나 자신을 싶었던, 그래서 당신을 위해 그것을 파악하는 시간이 걸렸다 (날!).
기본적으로, 모든 NamedSlideShows를 통해) 루프 할 것, b)는 SlideID하여 슬라이드를 찾아, C) 원래의 디자인과 NamedSlideShow 슬라이드를 통해) 새 프레젠테이션 후 D를 추가 복사합니다. 명령을 보내는 방법에 따라 하나 또는 모든 사용자 정의 프로그램에 대해이 작업을 수행 할 수 있습니다.
다음은 예입니다 :
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을 생성하는 루틴로 전송 찾습니다. 필요에 따라이를 사용자 정의 할 수 있습니다.
이 루틴은 아래의 루틴입니다. 몇 가지주의 할 수 있습니다
- 가 소스 슬라이드의 슬라이드 디자인을 통해 전송하려면 해당 디자인을 사용하여 복사 한 슬라이드를 설정 명시 적으로 에 있습니다.
NamedSlideShow은 SlideID 개의 슬라이드 만 제공합니다. 다음에 은 프리젠 테이션의 해당 슬라이드를 식별 할 수 있습니다. 슬라이드 개체를 반환합니다. 그런 다음 복사하고 원본의 디자인과 함께 붙여 넣기 만하면됩니다.
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
있다 없다 그 밖으로 일을해야합니다,하지만 매력처럼 작동하므로, 코드에서 확인 오류!