How to copy powerpoint sections to a new presentation using VBA

旧时模样 提交于 2021-02-19 06:55:25

问题


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!

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

回答1:


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


来源:https://stackoverflow.com/questions/56612747/how-to-copy-powerpoint-sections-to-a-new-presentation-using-vba

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!