☰

Word VBA：如何在预定义范围内运行Selection.Find？

tag-icon • tag-icon microsoft-word vba
Word VBA：如何在预定义范围内运行Selection.Find？

我这里有两段 Word VBA 代码，每段单独运行都很好，但我需要将它们组合起来才能获得所需的结果。一段识别文本范围 (oRng)，而另一段运行 Selection.Find 搜索以更改某些文本。我需要将 Selection.Find 搜索限制在 oRng 定义的范围内。

背景：我有一个可变的新闻文章列表，这些文章在标题下分为几部分（Header1 样式中的单个段落），标题也是可变的。我需要选择文章中的源行（粗体单个段落）并将其复制到文章标题的末尾（Header2 样式中的单个段落）。但是，如果部分标题是特定术语，则需要从此操作中排除某些部分。

情况：我有工作代码来查找文章源代码行并将其复制到文章标题的末尾（使用 Selection.Find 循环遍历整个文档）。我还有工作代码来识别需要应用第一组代码的文本部分，方法是在适用的部分标题之间创建范围（oRng），逐节循环遍历文档。我需要做的是在第二组代码指定的范围内运行第一组代码（基于 Selection.Find）。我的目的是循环代码以识别范围，并在识别每个范围时运行代码以将源代码行复制到该范围内的标题，但我找不到将 Selection.Find 搜索限制在特定范围（oRng）的方法。

有人可以帮我解决这个问题吗？

第一个代码块（识别适用节标题之间的范围）

Sub SourceToArticleHeadersP2()
Dim oRng As Range
Dim oRngstart As Range
Dim oRngend As Range
Dim ArticleSource As Range
Dim ArticleHeader As Range
Dim excludedTerms(1 To 5) As String
excludedTerms(1) = "Term1"
excludedTerms(2) = "Term1"
excludedTerms(3) = "Term1"
excludedTerms(4) = "Term1"
excludedTerms(5) = "Term1"

Selection.HomeKey Unit:=wdStory
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Style = ActiveDocument.Styles(wdStyleHeading1)
.Text = ""
.Execute
End With
Do While Selection.Find.Found
 For i = 1 To 5
  If InStr(1, Selection.Text, excludedTerms(i), vbTextCompare) Then
  Selection.Collapse wdCollapseEnd
  MsgBox excludedTerms(i) & " detected - skipping"
  Selection.Find.Execute
  End If
 Next i
 Set oRngstart = Selection.Range
 MsgBox "Start = " & oRngstart
 Selection.Collapse wdCollapseEnd
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Style = ActiveDocument.Styles(wdStyleHeading1)
  .Text = ""
  .Execute
 End With
 If Selection.Find.Found Then
  Set oRngend = Selection.Range
  MsgBox "End = " & oRngend
  Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=oRngend.Start)
  Selection.Collapse wdCollapseStart
  Selection.Find.Execute
 Else
  MsgBox "End = End of Document"
  Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=ActiveDocument.Range.End)
 End If
Loop
[SECOND BLOCK OF CODE GOES HERE]
End Sub

第二段代码（根据格式识别源行并复制到文章标题行）。我需要修改它，以便它只对文本 oRng 范围起作用。

With Selection.Find
 .Forward = True
 .ClearFormatting
 .Wrap = wdFindStop
 .Style = ActiveDocument.Styles(wdStyleHeading2)
 .Text = ""
 .Execute
End With
Do While Selection.Find.Found
 Set ArticleHeader = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Font.Bold = True
  .Text = ""
  .Execute
  End With
 Set ArticleSource = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
 ArticleHeader.InsertAfter " (" & ArticleSource & ")"
 Selection.Collapse wdCollapseEnd
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Style = ActiveDocument.Styles(wdStyleHeading2)
  .Text = ""
  .Execute
 End With
Loop

目标文档的布局与此类似（部分和文章的数量是可变的）。我在上面的代码中搜索的行以粗体显示：

[2+ 页开篇文字和目录]

节标题 1（样式：Heading1）

第 1 条标题（样式：Heading2）
标题文本可变行
第 1 条来源名称（粗体）
更多可变的标题文本行
文章正文文本
分页符

第 2 条标题（样式：Heading2）
标题文本可变行
第 2 条来源名称（粗体）
更多可变的标题文本行
文章正文文本
分页符

节标题 2（样式：Heading1）

第 3 条标题（样式：Heading2）
标题文本可变行
第 3 条来源名称（粗体）
更多可变的标题文本行
文章正文文本
分页符

[...]

答案1

最后，我能够通过计算 oRng 中使用 Header2 样式的段落数量，并从 oRng 的开头循环第二次搜索适当次数来解决这个问题（下面的代码）。

我仍然非常感兴趣地知道是否有另一种方法来限制具有多个搜索的循环，以便它仅在特定范围内运行 - 我唯一的想法是使用 oRng.Find 运行第一次搜索，折叠到结束，将 oRng 重新定义为（当前位置，oRngend）并以此方式循环，随着搜索向前移动，范围逐渐变小，直到到达当前位置和 oRngend 之间没有匹配的点。

非常感谢@Raystafarian 提供的大量有用建议和极大的耐心！

Sub SourceToArticleHeaders()
'Copy article source to article header
    Dim oRng As Range
    Dim oRngstart As Range
    Dim oRngend As Range
    Dim ArticleSource As Range
    Dim ArticleHeader As Range
    Dim oPara As Paragraph
    Dim A As Long
    A = 0
    Dim excludedTerms(1 To 5) As String
    excludedTerms(1) = "TERM1"
    excludedTerms(2) = "TERM1"
    excludedTerms(3) = "TERM1"
    excludedTerms(4) = "TERM1"
    excludedTerms(5) = "TERM1"

    Selection.HomeKey Unit:=wdStory
    With Selection.Find
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindStop
    .Style = ActiveDocument.Styles(wdStyleHeading1)
    .Text = ""
    .Execute
    End With
    Do While Selection.Find.Found
     For i = 1 To 5
      If InStr(1, Selection.Text, excludedTerms(i), vbTextCompare) Then
      Selection.Collapse wdCollapseEnd
'      MsgBox excludedTerms(i) & " detected - skipping"
      Selection.Find.Execute
      End If
     Next i
     Set oRngstart = Selection.Range
'     MsgBox "Start = " & oRngstart
     Selection.Collapse wdCollapseEnd
     With Selection.Find
      .Forward = True
      .ClearFormatting
      .Wrap = wdFindStop
      .Style = ActiveDocument.Styles(wdStyleHeading1)
      .Text = ""
      .Execute
     End With
     If Selection.Find.Found Then
      Set oRngend = Selection.Range
'      MsgBox "End = " & oRngend
      Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=oRngend.Start)
      Selection.Collapse wdCollapseStart
      Selection.Find.Execute
     Else
'      MsgBox "End = End of Document"
      Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=ActiveDocument.Range.End)
     End If
     For Each oPara In oRng.Paragraphs
      If oPara.Range.Style = ActiveDocument.Styles(wdStyleHeading2) Then
      A = A + 1
      End If
     Next
'     MsgBox A & " articles"
     oRng.Select
     For A = 1 To A
     With Selection.Find
     .Forward = True
     .ClearFormatting
     .Wrap = wdFindStop
     .Style = ActiveDocument.Styles(wdStyleHeading2)
     .Text = ""
     .Execute
     End With
     Set ArticleHeader = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
     Selection.Collapse wdCollapseEnd
     With Selection.Find
      .Forward = True
      .ClearFormatting
      .Wrap = wdFindStop
      .Font.Bold = True
      .Text = ""
      .Execute
     End With
     Set ArticleSource = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
     ArticleHeader.InsertAfter " (" & ArticleSource & ")"
     Selection.Collapse wdCollapseEnd
     Next A
     A = 0
     With Selection.Find
      .Forward = True
      .ClearFormatting
      .Wrap = wdFindStop
      .Style = ActiveDocument.Styles(wdStyleHeading1)
      .Text = ""
      .Execute
     End With
    Loop
End Sub

相关内容