时间戳

首页 > 解决方案 > 使用 VBA 插入时，如何确保从另一个 PowerPoint 演示文稿中复制和粘贴的幻灯片顺序正确

vba - 使用 VBA 插入时，如何确保从另一个 PowerPoint 演示文稿中复制和粘贴的幻灯片顺序正确

问题描述

我正在使用此代码轻松插入另一个演示文稿中的幻灯片。它工作正常，但我注意到复制的幻灯片以随机顺序出现。即它们在 PowerPoint 文件中的顺序不同。请问我该如何解决这个问题？

Dim i As Integer
Dim PPDD As String
Dim X As Long
Dim Y As Long
Dim Z As Long

  With Application.FileDialog(msoFileDialogFilePicker)

        .AllowMultiSelect = False
        .Filters.Add "PowerPoint Files", "*.pptx; *.ppt; *.pptm; *.ppsm", 1
        .Show
        On Error Resume Next
        PPDD = .SelectedItems.Item(1)
        End With


        X = InputBox("Please enter which position (slide number) you'd like the selected PowerPoint file to be inserted", "slide number", "1")
        Y = InputBox("Please enter the number of the first slide you want to copy", "slide number", "1")
        Z = InputBox("Please enter the number of the last slide you want to copy", "slide number", "1")

Set objPresentation = Presentations.Open(PPDD, WithWindow:=msoFalse)
For i = Y To Z
    objPresentation.Slides.Item(i).Copy
    Presentations.Item(1).Slides.Paste X
    Presentations.Item(1).Slides.Item(Presentations.Item(1).Slides.count).Design = _
        objPresentation.Slides.Item(i).Design
Next i
objPresentation.Close

标签： vbapowerpoint

解决方案

您的问题是它以相反的顺序输入它们。当你打电话时Presentations.Item(1).Slides.Paste X，它会一直粘贴到那个 X 位置。您真正想要的是在粘贴时逐渐抵消原始索引。

我改变了变量处理，但它本质上是一样的。

Option Explicit 

Sub CopySlide()

    Dim pptStart As Presentation
    Set pptStart = ActivePresentation

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "PowerPoint Files", "*.pptx; *.ppt; *.pptm; *.ppsm", 1
        .Show

        On Error Resume Next
        Dim PPDD As String
        PPDD = .SelectedItems.Item(1)
        On Error GoTo 0
    End With

    If Len(PPDD) = 0 Then
        MsgBox "File not chosen. Closing."
        Exit Sub
    End If

    Dim pptOpened As Presentation
    Set pptOpened = Presentations.Open(PPDD, WithWindow:=msoFalse)


    Dim indexInsertAt As Long
    indexInsertAt = InputBox("Please enter which position (slide number) you'd like the selected PowerPoint file to be inserted", "slide number", "1")

    Dim indexCopyFirst As Long
    indexCopyFirst = InputBox("Please enter the number of the first slide you want to copy", "slide number", "1")

    Dim indexCopyLast As Long
    indexCopyLast = InputBox("Please enter the number of the last slide you want to copy", "slide number", "1")


    Dim offset As Long

    Dim i As Long
    For i = indexCopyFirst To indexCopyLast

        pptOpened.Slides.Item(i).Copy
        pptStart.Slides.Paste (indexInsertAt + offset)

        pptStart.Slides.Item(indexInsertAt + offset).Design = _
            pptOpened.Slides.Item(i).Design

        offset = offset + 1
    Next i

    pptOpened.Close

End Sub

推荐阅读