在 MS PowerPoint 中查找和突出显示文本 [英] Find and Highlight Text in MS PowerPoint

问题描述

我使用了这个网站的一些代码来制作一个宏来在 Word 文档上进行关键字搜索并突出显示结果.

I used some code from this site to make a macro to do a keyword search on Word docs and highlight the results.

我想在 PowerPoint 中复制效果.

I would like to replicate the effect in PowerPoint.

这是我的 Word 代码.

Here is my code for Word.

Sub HighlightKeywords()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for

For i = 0 To UBound(TargetList) ' for the length of the array

   Set range = ActiveDocument.range

   With range.Find ' find text withing the range "active document"
   .Text = TargetList(i) ' that has the words from the array TargetList
   .Format = True ' with the same format
   .MatchCase = False ' and is case insensitive
   .MatchWholeWord = True ' and is not part of a larger word
   .MatchAllWordForms = False ' and DO NOT search for all permutations of the word

   Do While .Execute(Forward:=True)
   range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow

   Loop

   End With
Next

End Sub

这是我目前在 PowerPoint 中所拥有的，它根本没有任何功能.

Here is what I have so far in PowerPoint, it is in no way functional.

Sub HighlightKeywords()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for

For Each sld In Application.ActivePresentation.Slides

For Each shp In sld.Shapes

    If shp.HasTextFrame Then

        Set txtRng = shp.TextFrame.TextRange

For i = 0 To UBound(TargetList) ' for the length of the array

   With range.txtRng ' find text withing the range "shape, text frame, text range"
   .Text = TargetList(i) ' that has the words from the array TargetList
   .Format = True ' with the same format
   .MatchCase = False ' and is case insensitive
   .MatchWholeWord = True ' and is not part of a larger word
   .MatchAllWordForms = False ' and DO NOT search for all permutations of the word

   Do While .Execute(Forward:=True)
   range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow

   Loop

   End With
Next

End Sub

<小时>

我最终通过 MSDN 找到了我的答案，但这与我从人们提交的内容中选择为正确的答案非常接近.

---

I ended up finding my answer through the MSDN, but it was very close to the answer I selected as correct from what people submitted.

这是我使用的代码:

Sub Keywords()

Dim TargetList
Dim element As Variant

TargetList = Array("First", "Second", "Third", "Etc")

For Each element In TargetList
   For Each sld In Application.ActivePresentation.Slides
      For Each shp In sld.Shapes
         If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange
            Set foundText = txtRng.Find(FindWhat:=element, MatchCase:=False, WholeWords:=True)
            Do While Not (foundText Is Nothing)
               With foundText
                  .Font.Bold = True
                  .Font.Color.RGB = RGB(255, 0, 0)
               End With
            Loop
         End If
      Next
   Next
Next element

End Sub

<小时>

事实证明该代码有效，但却是一场性能噩梦.我在下面选择为正确答案的代码运行得更加流畅.我已经调整了我的程序以匹配所选的答案.

---

Turns out that code worked, but was a performance nightmare. The code I selected as the correct answer below runs much more smoothly. I've adjusted my program to match the answer selected.

推荐答案

AFAIK 没有内置方法可以用颜色突出显示找到的单词.您可以特意创建一个矩形并将其放在找到的文本后面并为其着色，但那是完全不同的球类游戏.

AFAIK there is no inbuilt way to highlight the found word with a color. You could go out of the way to create a rectangular shape and place it behind the found text and color it but that is a different ball game altogether.

这是一个示例，它将搜索所有幻灯片中的文本，然后将找到的文本设为粗体、下划线和斜体.如果需要，您还可以更改字体的颜色.

Here is an example which will search for the text in all slides and then make the found text BOLD, UNDERLINE and ITALICIZED. If you want you can also change the color of the font.

假设我们有一张像这样的幻灯片

Let's say we have a slide which looks like this

将此代码粘贴到模块中，然后尝试一下.我已经对代码进行了注释，这样您就不会在理解它时出现问题.

Paste this code in a module and then try it. I have commented the code so that you will not have a problem understanding it.

Option Explicit

Sub HighlightKeywords()
    Dim sld As Slide
    Dim shp As Shape
    Dim txtRng As TextRange, rngFound As TextRange
    Dim i As Long, n As Long
    Dim TargetList

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

    '~~> Loop through each slide
    For Each sld In Application.ActivePresentation.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 = msoTrue
                            .Underline = msoTrue
                            .Italic = msoTrue
                            '~~> Find Next instance
                            Set rngFound = txtRng.Find(TargetList(i), n)
                        End With
                    Loop
                Next
            End If
        Next
    Next
End Sub

最终截图

这篇关于在 MS PowerPoint 中查找和突出显示文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！