如何使用 VBA 将 powerpoint 部分复制到新的演示文稿 [英] How to copy powerpoint sections to a new presentation using VBA

问题描述

我们通常使用 powerpoint 来促进我们的实验.我们在 powerpoint 中使用部分"来为每个实验任务将幻灯片组放在一起.移动部分以平衡实验的任务顺序已经做了很多工作！

We typically use powerpoint to facilitate our experiments. We use "sections" in powerpoint to keep groups of slides together for each experimental task. Moving the sections to counterbalance the task order of the experiment has been a lot of work!

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

I thought we might be able to predefine a counterbalance order (using a string of numbers representing the order) in a CSV or array (haven't built that out yet in VBA). Then using VBA to move the sections and save the file for each order. I am pretty rusty using VBA but I think I have a pretty good start. The problem is on line 24. I have no idea how to copy the section to the new presentation. Is anyone familiar enough to steer me down the right path.

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 粘贴幻灯片，因为将最后一张幻灯片的部分移动到新粘贴的幻灯片.

If you want to copy slides with their sections, then you can not paste the slide by newPresentation.Slides.Paste only, as that moves the section of the last slide to the newly pasted slide.

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

Here's an example how to copy slide-by-slide, check if a slide is the beginning of a section, and how to add a new section then:

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

这篇关于如何使用 VBA 将 powerpoint 部分复制到新的演示文稿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！