VSTO加载项可自动导出自定义PowerPoint幻灯片

Nak*_*nch 4 powerpoint vsto

我公司的一个小组在一个非常大的PowerPoint幻灯片上工作.并非此套牌中的所有幻灯片都与每个人都相关.这个套牌的目的是拥有一个独特的材料来源,人们可以根据所需的演示类型挑选和选择幻灯片.幻灯片有许多预定义的自定义幻灯片放映,使这个过程更容易.

虽然此解决方案在许多情况下运行良好,但我们需要一种简单的方法将自定义节目快速导出到新的演示文稿.我的目标是开发一个VSTO加载项,允许用户选择一个或多个自定义幻灯片放映,然后将幻灯片导出到他们的桌面,我正在寻找一些代码来帮助我顺利完成.

有谁知道如何将现有的自定义节目导出到新的演示文稿?更好的是,有没有办法允许用户选择和导出一个或多个现有节目?

Tod*_*ain 5

很好的问题,我很想自己做这个很长一段时间,所以花时间为你解决(和我!).

基本上,你会想要a)遍历所有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
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)

代码中没有任何错误检查,因此需要解决,但它就像一个魅力!