在单词中搜索单词，但忽略表格 [英] Searching for words in word, but ignoring tables

问题描述

我下面有一个很棒的宏

• 搜索单词(在excel文件中列出)
• 复制每个实例
• 将其与原始文档中的位置一起粘贴到新的word文档中

这是由不同的人创建和修改的，我的确很棒！！我想知道的一件事是:

This has been created and amended by various people and I am truly greatful!!. One thing that I was wondering if possible is:

如果要搜索的Word文档中有表格，您可以使宏忽略表格吗?还是最好说如果找到了单词并且在表中，请忽略此实例，然后再次搜索文档"

If in the word document which you're searching there are tables, can you make the macro to ignore tables? or would it be better to say 'If the word is found and is in a table ignore this instance and proceed searching te document again'

在我看来，后者将有更多不必要的迭代.

The latter would have more unnecessary iterations in my opinion.

我设法找到了代码:

Sub NonTableParagraphs()
    Dim rng() As Range
    Dim t As Integer
    Dim tbl As Table
    Dim para As Paragraph
    Dim r As Integer

    ReDim Preserve rng(t)
    Set rng(t) = ActiveDocument.Range
    For Each tbl In ActiveDocument.Tables
        rng(t).End = tbl.Range.Start
        t = t + 1
        ReDim Preserve rng(t)
        Set rng(t) = ActiveDocument.Range
        rng(t).Start = tbl.Range.End
    Next tbl
    rng(t).End = ActiveDocument.Range.End
    For r = 0 To t
        For Each para In rng(r).Paragraphs
             'do processing
        Next para
    Next r
End Sub

并尝试在原始宏中插入NonTableParagraphs，因此它将运行一个子例程，但我无法使其正常工作.

and had tried to insert NonTableParagraphs in the original macro, so it would run a sub routine, but I couldn't get it to work.

看来我应该尝试使用ActiveDocument.Tables并以某种方式说明如果ActiveDocument.Tables found，请跳过宏&中的其余行.然后返回到桌子后面搜索，但似乎无法正常工作.

It looks like I should be trying to use ActiveDocument.Tables and somehow stating if ActiveDocument.Tables found, skip the rest of the lines in macro & then return to searching after the table but I can't seem to get it to work.

我看看是否可以搜索

非常感谢！

Sub CopyKeywordPlusContext()
'Modified 3-10-2015 TW
'Modified 2-17-2015 GKM
'Makro created on 22.01.2013
Dim oDoc As Document, oDocRecord As Document
Dim strSearch As String, arrSearch
Dim lngCharTrailing As Long, lngCharLeading As Long, lngIndex As Long, lngCount As Long
Dim lngPgNum, lngLineNum As Integer
Dim oRng As Word.Range, oRngSpan As Word.Range
Dim bFound As Boolean
Dim oTbl As Word.Table
  strSearch = vbNullString
  Dim xl As Object
Set xl = GetObject(, "Excel.Application")
arrSearch = xl.transpose(xl.activesheet.Range("A1:A221").Value)
  lngCharLeading = 20
  lngCharTrailing = 20
  Set oDoc = ActiveDocument
    For lngIndex = 1 To UBound(arrSearch)
    ResetFRParams
    bFound = False
    lngCount = 0
    Set oRng = oDoc.Range
    With oRng.Find
      .Text = LCase(arrSearch(lngIndex))
      While .Execute
        bFound = True
        If oDocRecord Is Nothing Then
          Set oDocRecord = Documents.Add
          Set oTbl = oDocRecord.Tables.Add(oDocRecord.Range, 1, 2)
        End If
        lngCount = lngCount + 1
        If lngCount = 1 Then
          oTbl.Rows.Add
          With oTbl.Rows.Last.Previous
            .Cells.Merge
            With .Cells(1).Range
              .Text = "Search results for """ & arrSearch(lngIndex) & """ + context in " & """" & oDoc.Name & """"
              .Font.Bold = True
            End With
          End With
        End If
        Set oRngSpan = oRng.Duplicate
        oRngSpan.Select
        lngPgNum = Selection.Information(wdActiveEndPageNumber)
        lngLineNum = Selection.Information(wdFirstCharacterLineNumber)
        With oRngSpan
          .MoveStart wdCharacter, -lngCharLeading
          .MoveEnd wdCharacter, lngCharTrailing
          Do While oRngSpan.Characters.First = vbCr
            oRngSpan.MoveStart wdCharacter, -1
          Loop
          Do While oRngSpan.Characters.Last = vbCr
            oRngSpan.MoveEnd wdCharacter, 1
            If oRngSpan.End = oDoc.Range.End Then
              oRngSpan.End = oRngSpan.End - 1
              Exit Do
            End If
          Loop
        End With
        oTbl.Rows.Last.Range.Cells(1).Range.Text = Trim(oRngSpan.Text)
        oTbl.Rows.Last.Range.Cells(2).Range.Text = "Page: " & lngPgNum & " Line: " & lngLineNum
        oTbl.Rows.Add
      Wend
    End With
    If bFound Then
      ResetFRParams
      With oDocRecord.Range.Find
        .Text = LCase(arrSearch(lngIndex))
        .Replacement.Text = "^&"
        .Replacement.Highlight = True
        .Format = True
        .Execute Replace:=wdReplaceAll
      End With
    End If
  Next lngIndex
  oTbl.Rows.Last.Delete
End Sub
Sub ResetFRParams()
    With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Replacement.Highlight = False
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
lbl_Exit:
  Exit Sub
End Sub

推荐答案

与其尝试调试/编辑代码，不如直接查看并自行决定将其插入何处.

Instead of trying to debug/edit your code look at this and decide for yourself where to insert it.

Sub FindText()
    Dim doc As Word.Document, rng As Word.Range
    Set doc = Word.ActiveDocument
    Set rng = doc.Content
    With rng.Find
        .ClearFormatting
        .Format = False
        .Forward = True
        .Text = "Now is"
        .Wrap = wdFindStop
        .Execute
        Do While .Found
            If rng.Information(Word.WdInformation.wdWithInTable) Then
                'do nothing
                rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            Else
                rng.Text = "Now is not"
                rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            End If
            .Execute
        Loop
    End With
End Sub

这篇关于在单词中搜索单词，但忽略表格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！