如何在 PowerPoint 中 select 多张幻灯片，然后多次复制它们？

Question

我试图在同一个演示文稿中多次复制选定的幻灯片。有人可以告诉我哪里出错了吗？谢谢

Public Sub DuplicateSlideMultipleTimes()
    Dim n As Integer
    On Error Resume Next
    n = InputBox("How many copies of the selected slides do you want to make?")

    Dim mySlides As Slides
    Set mySlides = ActiveWindow.Selection.SlideRange

    If n >= 1 Then
        For numtimes = 1 To n
            mySlides.Copy After:=ActivePresentation.Slides(ActivePresentation.Slides.Count)
        Next
    End If
End Sub

Answer 1

你很接近。

一些亮点：

尽可能避免错误继续下一步（这只会隐藏您有错误的地方）
声明所有变量（在模块顶部使用 Option Explicit）
你有一些变量类型错误

查看代码注释并根据您的需要进行调整

代码：

Option Explicit

Public Sub DuplicateSlideMultipleTimes()

    Dim sourceSlide As Slide
    Dim selectedSlides As SlideRange

    Dim numTimes As Variant
    Dim counter As Long
    Dim totalCounter As Long

    ' Ask user for num slides
    numTimes = InputBox("How many copies of the selected slides do you want to make?")

    ' Check if numTimes is a number otherwise, exit procedure
    If Not IsNumeric(numTimes) Then Exit Sub

    ' Set a reference to the selected slides
    Set selectedSlides = ActiveWindow.Selection.SlideRange

    ' Loop through each slide in the selected slides
    For Each sourceSlide In selectedSlides
        For counter = 1 To numTimes
            ' Duplicate the slide
            sourceSlide.Duplicate
            ' Track total number of duplicated slides
            totalCounter = totalCounter + 1
        Next counter
    Next sourceSlide

    ' Display message to user
    MsgBox totalCounter & " duplicates generated"

End Sub

如果有效请告诉我

Answer 2

这是另一种方法。它不是循环遍历每张选定的幻灯片来制作副本，而是简单地复制和粘贴。它还将它们放在演示文稿的末尾。

请注意，mySlides 已被适当地声明为 SlideRange，正如 Ricardo 已经指出的那样。

另请注意，On Error Resume Next 已被删除，因为它可以在使用不当时隐藏错误，正如 Ricardo 也指出的那样。

Option Explicit

Public Sub DuplicateSlideMultipleTimes()

    Dim ans As String
    Dim num_copies As Long

    num_copies = 0
    Do
        ans = InputBox("How many copies of the selected slides do you want to make?")
        If Len(ans) = 0 Then Exit Sub
        If IsNumeric(ans) Then
            num_copies = CLng(ans)
            If num_copies > 1 Then Exit Do
        End If
        MsgBox "Invalid entry, try again!", vbExclamation
    Loop

    Dim mySlides As SlideRange
    Set mySlides = ActiveWindow.Selection.SlideRange

    Dim i As Long
    For i = 1 To num_copies
        mySlides.Copy
        ActivePresentation.Slides.Paste
    Next i

    MsgBox "Completed!", vbExclamation

End Sub

如何在 PowerPoint 中 select 多张幻灯片，然后多次复制它们？

How to select multiple slides in PowerPoint and then Duplicate them multiple times?

powerpoint

vba

一些亮点：