将基于特定单词的幻灯片复制到新演示文稿答案

【问题标题】：Copy slide based on specific words to new presentation将基于特定单词的幻灯片复制到新演示文稿
【发布时间】：2018-01-16 01:46:35
【问题描述】：

我有一个包含约 60 张幻灯片的主 PowerPoint 演示文稿。

我想浏览整个幻灯片并复制具有特定文本的特定幻灯片。我可以使用构成选择基础的关键词创建一个数组，但不知道如何复制整个幻灯片。

以下代码是网上搜索的结果。

Sub selct()

Dim pres1 As PowerPoint.Presentation, pres2 As PowerPoint.Presentation, 
pp  As Object
Set pp = GetObject(, "PowerPoint.Application")

Set pres1 = pp.ActivePresentation
Set pres2 = pp.Presentations.Add

Dim i As Long, n As Long
Dim TargetList

'~~>  Array of terms to search for
TargetList = Array("Agenda", "Review", "third", "etc")

'~~> Loop through each slide
For Each sld In pres1.Slides
    '~~> Loop through each shape
    For Each shp In sld.Shapes
        '~~> Check if it has text
        If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange

            For i = 0 To UBound(TargetList)
                '~~> Find the text
                Set rngFound = txtRng.Find(TargetList(i))

                '~~~> If found
                Do While Not rngFound Is Nothing
                    '~~> Set the marker so that the next find starts from here
                    n = rngFound.Start + 1
                    '~~> Chnage attributes
                   With rngFound.Font
                        .Bold = msoFalse
                        sld.Copy
                        pres2.Slides.Paste
                        '~~> Find Next instance
                        Set rngFound = txtRng.Find(TargetList(i), n)
                    End With
                Loop
            Next
        End If
    Next
Next
End Sub

上面复制了幻灯片，但没有复制格式。此外，幻灯片会重复，以便新演示文稿中的幻灯片数量与主演示文稿中的幻灯片数量相同，此时它应该是子集。例如，母版有 60 张幻灯片，而新演示文稿也有 60 张幻灯片而不是 20 张。

如何仅复制具有目标数组中特定单词的幻灯片并保持幻灯片的格式？

【问题讨论】：

查看 PowerPoint 对象模型引用，特别是 Slide Object 类型，注意它是 Copy 方法。 msdn.microsoft.com/en-us/vba/powerpoint-vba/articles/… 还有一个Select 的方法，不过可能没必要用，直接Copy 粘贴即可。
谢谢大卫，我使用了复制方法并修改了代码如下
我使用了 .Copy 函数，它可以工作。但是粘贴的幻灯片是重复的，因此新演示文稿中的幻灯片总数是母版并且没有源格式。任何想法如何我可以只复制特定的幻灯片并保持源格式。谢谢
为了提供答案，您有必要修改您的问题以包含您当前的代码实现。听起来您正在复制每张幻灯片，但实际上您应该只在满足匹配条件后才执行copy/paste。这样它只会复制那些需要的幻灯片。
我现在已经输入了整个代码。

标签： vba copy powerpoint

【解决方案1】：

我认为首先您需要确保pres2 使用与pres1 相同的设计模板/主题。如果pres2 使用不同的主题，则幻灯片将反映该主题。我不记得如何在不花一些时间调试的情况下做到这一点，但是由于您是从空白演示文稿开始，这可能是最简单的：

首先，从pres2删除所有张幻灯片：

Set pres2 = pp.Presentations.Add
Dim i as Long
For i = pres2.Slides.Count to 1 Step - 1
    pres2.Slides(i).Delete
Next

现在您有一个空演示文稿，Paste 来自pres1 的幻灯片应该保留布局/主题。

sld.Copy
pres2.Slides.Paste

【讨论】：