Question

我有梦幻般的宏

搜索单词（在Excel文件中列出）
复制每个实例
与原始文档中的位置一起粘贴到新的Word文档

这是由各种各样的人创造和修改的，我真的很棒!!有一件事我想知道是否可能：

如果在您正在搜索的单词文档中有表格，您是否可以使宏忽略表格？或者更好地说＆＃39;如果找到该单词并且在表中，则忽略该实例并再次继续搜索文档＆＃39;

后者在我看来会有更多不必要的迭代。

我设法找到了代码：

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，因此它会运行一个子例程，但我无法使其工作。

看起来我应该尝试使用ActiveDocument.Tables并以某种方式说明是否ActiveDocument.Tables found，跳过宏和＆amp;中的其余行。然后回到桌子后面搜索，但我似乎无法让它发挥作用。

我会看看我是否可以搜索

非常感谢!!!

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

Answer 1

不要试图调试/编辑你的代码，而是自己决定在哪里插入它。

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

搜索单词中的单词，但忽略表格

1 个答案: