将PowerPoint文件多张幻灯片拆分为1张幻灯片的多个文件的最快方法是什么?

时间:2019-07-18 15:33:21

标签: vba powerpoint

我有一个包含50张幻灯片的文件。我需要创建50张包含每张幻灯片的不同幻灯片。我想最快的方法包括VBA,但是我不知道如何让VBA创建一个新文件然后再回到主文件...

3 个答案:

答案 0 :(得分:1)

假设您的意思是“创建50个演示文稿”,那么这将起作用。在运行代码之前创建目标文件夹:

Sub ExportSlides()
  For X = 1 To ActivePresentation.Slides.Count
    ActivePresentation.Slides(X).Export "c:\temp\slide" & X & ".pptx", "PPTX"
  Next X
End Sub

答案 1 :(得分:0)

我终于找到了:

r'\s*\([^)]*\)'

答案 2 :(得分:-1)

我用于类似项目的这段代码应该可以将每个 PPT 文件拆分为其 PPT 文件并将其保存到包含原始 PPT 文件的文件夹中。

一些注意事项:

  • 它在处理嵌入的图形和背景时遇到困难。
  • 这会去除分配给幻灯片或模板的所有动画。如果您想保留动画或效果,只需去掉这些代码行
  • 我没有花时间让自动显示的用户窗体变得顺畅,但您可以通过转到“开发人员”选项卡并从宏列表中运行 OnPresentationOpen 子例程来轻松运行它。

根据您环境的安全设置,您可能还需要将包含此 VBA 的 .pptm 设置为可信文档,然后它才能工作。

Option Explicit
Sub OnPresentationOpen()
    UserForm1.Show
End Sub

Public Sub ProcessPowerPoint(pptCalled)
    Dim pptMainPowerPt As Presentation
    Dim slideCount As Long
    Dim i As Long
    Dim cleanSlide As Slide
    Dim newSaveName As String
    
    Set pptMainPowerPt = Presentations.Open(pptCalled)
    slideCount = ActivePresentation.Slides.Count
    
    ' Removes all animations from entire document first
    For Each cleanSlide In ActivePresentation.Slides
        For i = cleanSlide.TimeLine.MainSequence.Count To 1 Step -1
            'Remove Each Animation
            cleanSlide.TimeLine.MainSequence.Item(i).Delete
        Next i
    Next cleanSlide
    
    Debug.Print "The number of slides is "; slideCount
    Debug.Print "The name that is showing is "; pptCalled
    Debug.Print ActivePresentation.Name
    
    newSaveName = Left(pptCalled, InStr(pptCalled, ".") - 1)
    
    Debug.Print "Substring name is "; newSaveName
    
    For i = 1 To slideCount
        Dim newPresentation As Presentation
        Dim newName As String
        Dim currentSlide As Slide
         
        newName = newSaveName + "_Slide_" & i & ".pptx"
      
        Set currentSlide = pptMainPowerPt.Slides.Item(i)
        Set newPresentation = Application.Presentations.Add
        currentSlide.Copy
        newPresentation.Slides.Paste
        
       newPresentation.SaveAs (newName)
       newPresentation.Close
          
    Next
  
    pptMainPowerPt.Close
    
End Sub