在 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屋!