Question

我正在尝试在powerpoint中创建一个宏来自动执行一些常规任务。所以，我有一个主要的powerpoint，有大约60个幻灯片。我想创建一个宏，它将遍历整个套牌并复制其中包含特定文本的特定幻灯片。我可以使用构成选择基础的关键词创建一个数组，但无法弄清楚如何复制整个幻灯片。下面的代码是在互联网上进行一些觅食的结果。

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

以上复制幻灯片但不复制格式。另外，幻灯片重复进行，使得新的powerpoint中的幻灯片数量在主演示文稿中，当它应该是子集时。例如，主人有60张幻灯片，而新的powerpoint也有60张幻灯片，而不是20张，比如说。

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

非常感谢任何帮助！

由于

取值

Answer 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

VBA根据特定单词选择幻灯片并复制到新演示文稿

1 个答案: