简体   繁体   English

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

[英]How to copy powerpoint sections to a new presentation using VBA

We typically use powerpoint to facilitate our experiments.我们通常使用 powerpoint 来促进我们的实验。 We use "sections" in powerpoint to keep groups of slides together for each experimental task.我们在 powerpoint 中使用“部分”来为每个实验任务将幻灯片组放在一起。 Moving the sections to counterbalance the task order of the experiment has been a lot of work!移动部分以平衡实验的任务顺序已经做了很多工作!

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).我认为我们可以在 CSV 或数组(尚未在 VBA 中构建)中预定义一个平衡订单(使用一串代表订单的数字)。 Then using VBA to move the sections and save the file for each order.然后使用 VBA 移动部分并为每个订单保存文件。 I am pretty rusty using VBA but I think I have a pretty good start.我对 VBA 的使用非常生疏,但我认为我有一个很好的开始。 The problem is on line 24. I have no idea how to copy the section to the new presentation.问题出在第 24 行。我不知道如何将该部分复制到新的演示文稿中。 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

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.如果要复制幻灯片及其部分,则不能仅通过newPresentation.Slides.Paste粘贴幻灯片,因为这会将最后一张幻灯片的部分移动到新粘贴的幻灯片。

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM