Как скопировать разделы PowerPoint в новую презентацию с помощью VBA - PullRequest
Новая
       36

Как скопировать разделы PowerPoint в новую презентацию с помощью VBA

1 голос
/ 15 июня 2019

Обычно мы используем 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

1 Ответ

1 голос
/ 16 июня 2019

Если вы хотите скопировать слайды с их разделами, то вы не можете вставить слайд только на 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
...