Searching for words in word, but ignoring tables

问题

I have the fantastic macro below which

• Searches for words (listed in an excel file)
• Copies each instance
• Pastes into a new word document together with it's location from the original document

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

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.

I had managed to find the code:

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

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.

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.

I'll see if I can search for that

Many thanks!!!

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

回答1:

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

来源：https://stackoverflow.com/questions/28991705/searching-for-words-in-word-but-ignoring-tables