我创建了一个用于在一系列文档中查找文本的函数,并在找到的文本上加上阴影。 我按以下方式运行代码,但是它将找到整个文档文本并应用阴影。
如何使该功能起作用?谢谢!
Public Function myFun_findTxt2addShading( _
str_findTxt As String, _
range_myRange, _
str_repTxt As String, _
str_ShadingColor As String) As Boolean
Dim boolean_checkFound As Boolean
boolean_checkFound = False
range_myRange.Select
With Selection
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
.Find.Text = str_findTxt
.Find.Replacement.Text = str_repTxt
.Find.Forward = True
.Find.Replacement.Font.ColorIndex = str_RepFontColor
.Find.Wrap = wdFindStop
Do While .Find.Execute
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = str_ShadingColor
boolean_check = True
Loop
.Find.Format = False
.Find.MatchCase = False
.Find.MatchWholeWord = False
.Find.MatchByte = False
.Find.MatchWildcards = False
.Find.MatchSoundsLike = False
.Find.MatchAllWordForms = False
End With
findTxt_Shading = boolean_checkFound
End Function
Sub test()
With Selection
.HomeKey Unit:=wdStory
.Find.Execute findText:="bookmark1", Forward:=True, Wrap:=wdFindStop
.MoveDown Unit:=wdLine
.HomeKey Unit:=wdLine
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sybStart"
.Find.Execute findText:="bookmark2", Forward:=True, Wrap:=wdFindStop
.HomeKey Unit:=wdLine
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sybEnd"
End With
Set sybRange = ActiveDocument.Range
sybRange.Start = sybRange.Bookmarks("sybStart").Range.End
sybRange.End = sybRange.Bookmarks("sybEnd").Range.Start
a = myFun_findTxt2addShading("pp", sybRange, "pp", wdColorYellow)
End Sub
答案 0 :(得分:0)
帮自己一些忙。
在每个模块的顶部放置“显式选项”。
在VBA IDE中,转到Tools.Options.Editor,并确保选中“代码设置”组中的所有复选框。
在VBA IDE中,将光标置于“关键字”上,然后按F1键将打开该关键字的MS帮助页面。尝试使用.Find方法。
我整理了一下代码,并使用了更合理的命名(仅更合理)。现在,下面的代码将突出显示文档中所选内容中的每个单词。
请注意,我故意将两个分组使用,以便每次找到findTxt时都可以执行其他操作。如果只想突出显示文本,则可以省略第二个With组并将.Format从False更改为True。
Public Function AddShadingToFoundText( _
findTxt As String, _
repTxt As String, _
ShadingColor As WdColor) As Boolean
Dim findTxtFound As Boolean
findTxtFound = False
If myRange.Characters.Count < Len(findTxt) Then
' No point in searching if the selected text is
' smaller than the search text.
Exit Function
End if
With myRange.Duplicate
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = findTxt
.Replacement.Text = findTxt
.Forward = True
' str_RepFontColor
'.Find.Replacement.Font.ColorIndex = str_RepFontColor
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
' Make sure there is still room for the search text
Do While .Find.Found And .Start < myRange.End - Len(findTxt)
.Shading.Texture = wdTextureNone
.Shading.ForegroundPatternColor = WdColor.wdColorAutomatic
.Shading.BackgroundPatternColor = ShadingColor
.Collapse Direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
.Find.Execute
findTxtFound = True
Loop
End With
AddShadingToFoundText = findTxtFound
End Function
Sub test()
Dim a As Boolean
a = AddShadingToFoundText("row", Selection.Range, "row", WdColor.wdColorRed)
End Sub