如何使用VBA将PowerPoint部分复制到新的演示文稿

乔尔·佩辛格

我们通常使用Powerpoint来促进我们的实验。我们在PowerPoint中使用“部分”将幻灯片组组合在一起以完成每个实验任务。移动各个部分以平衡实验的任务顺序已经做了很多工作！

我认为我们可以在CSV或数组中预先定义一个平衡顺序（使用代表该顺序的数字字符串）（尚未在VBA中建立平衡顺序）。然后使用VBA移动部分并保存每个订单的文件。我对使用VBA感到非常生疏，但我认为我有一个很好的开始。问题在第24行。我不知道如何将本节复制到新的演示文稿中。有谁足够熟悉以引导我走上正确的道路。

Sub Latin_Square()
    Dim amountOfSubjects As Integer
    'Declare the amount of subjects you have in your study
    amountOfSubjects = 14

    Dim filePath As String
    filePath = "C:/1.pptx"

    Dim amountofsections As Integer
    Dim i As Integer
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim desktopPath As String
    'find out where user's desktop is
    desktopPath = Environ("UserProfile") & "\Desktop\"


    Dim oldPresentation As Presentation
    Dim newPresentation As Presentation
    'open the target presentation
    Set oldPresentation = Presentations.Open("C:\1.pptx")
    For i = 1 To oldPresentation.Slides.Count
        oldPresentation.Slides.Item(i).Copy
        newPresentation.Item(1).Slides.Paste
    Next i
    oldPresentation.Close

    With newPresentation
        .SaveCopyAs _
            FileName:=fso.BuildPath(desktopPath, "Test" & 1 & ".pptx"), _
            FileFormat:=ppSaveAsOpenXMLPresentation
    End With

End Sub

阿斯格

如果要复制包含其部分的幻灯片，则不能newPresentation.Slides.Paste仅粘贴幻灯片，因为这会将最后一张幻灯片的部分移到新粘贴的幻灯片上。

这是一个示例，如何逐张复制幻灯片，检查幻灯片是否是某节的开头，然后如何添加新节：

Public Sub CopySlidesWithSections()
    Dim oldPresentation As Presentation, newPresentation As Presentation
    Dim oldSlide As Slide, newSlide As Slide
    Dim oldSectionProperties As SectionProperties, newSectionProperties As SectionProperties
    Dim i As Integer

    Set oldPresentation = ActivePresentation
    Set oldSectionProperties = oldPresentation.SectionProperties

    Set newPresentation = Application.Presentations.Add
    Set newSectionProperties = newPresentation.SectionProperties

    For Each oldSlide In oldPresentation.Slides
        oldSlide.Copy
        ' Would lead to wrong sectioning: Set newSlide = newPresentation.Slides.Paste.Item(1)
        Set newSlide = newPresentation.Slides.Paste(newPresentation.Slides.Count + 1).Item(1)

        For i = 1 To oldSectionProperties.Count
            If oldSectionProperties.FirstSlide(i) = oldSlide.SlideIndex Then
                newSectionProperties.AddBeforeSlide _
                    newSlide.SlideIndex, _
                    oldSectionProperties.Name(i)
                Exit For
            End If
        Next i
    Next oldSlide
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。