Question

我正在开发将用作更大代码集一部分的代码，该代码集最终将回答一个特定单词出现在Word文档中可能包含多个页面的单个指定页面上的次数。

代码实际上试图实现的是一次只在一页上搜索一个短语，找到该短语，然后在该页面上找到该短语的位置之后立即复制字符串，并将字符串粘贴到另一个单词上doc。如果您能提出比我下面的方法更好的方法，那么我愿意改变现状，因为这比我一开始想的要困难得多。

Sub test()

'Find and Define Documents
Dim doc As Document
For Each doc In Documents
       If Left(doc.Name, 5) = "LEGAL" Then
       Dim MainDoc As Document
       Set MainDoc = doc
    End If
Next doc

For Each doc In Documents
    If doc.Name = "Document1" Then
       Dim OtherDoc As Document
       Set OtherDoc = doc
    End If
Next doc

'Start from top of main doc.
MainDoc.Activate
Selection.GoTo What:=(0)

'count # of pages in main doc. 
Dim iCount As Integer
iCount = 0

'Do for other procedures to be accomplished in the code
Do While iCount < ActiveDocument.BuiltInDocumentProperties("Number of Pages")
iCount = iCount + 1
MainDoc.Activate
Dim Range_Doc As Range
Set Range_Doc = MainDoc.GoTo(What:=wdGoToPage, Name:=iCount)
Set Range_Doc = Range_Doc.GoTo(What:=wdGoToBookmark, Name:="\page")

'Find & Count the number of times the word Apple appears on specific page
    Dim AppleCount As Integer
    If AppleCount > 0 Then
        Dim OriginalCount As Integer
        OriginalCount = AppleCount
    End If

    AppleCount = 0

   Range_Doc.Bookmarks("\page").Range.Select
    'Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "Apple"
        .Format = False
        .Wrap = 0
        .Forward = False

      Do While .Execute
        AppleCount = AppleCount + 1
      Loop
    End With

    Dim NewCount As Integer
    NewCount = AppleCount - OriginalCount

    If NewCount < 0 Then
        NewCount = 0
    End If


    'Locate where in the doc the find term was found and extract what is coming after it
    Set Range_Doc = MainDoc.GoTo(What:=wdGoToPage, Name:=iCount)
    Set Range_Doc = Range_Doc.GoTo(What:=wdGoToBookmark, Name:="\page")

    Dim objFind As Find
    Set objFind = Range_Doc.Find
    With Range_Doc.Find
       Counter = 0
       Do While .Execute(findText:="Apple", MatchWholeWord:=False, Forward:=True) = True And Counter < NewCount

       With Range_Doc
          Set objFind = Range_Doc.Find

          If objFind.Found Then
             Dim Range_Found As Range
             Set Range_Found = objFind.Parent

             Dim IntPos as Integer
             IntPos = Range_Found.End

             Dim AppleID
             Set AppleID = MainDoc.Range(Start:=IntPos, End:=IntPos + 33)

             OtherDoc.Content.InsertAfter ","
             OtherDoc.Content.InsertAfter AppleID

          End If

        End With
        Counter = Counter + 1
        Loop
    End With

Loop
End sub

Answer 1

也许基于以下内容：

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Rng As Range
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
With DocSrc
  Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=3)
  Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
  With Rng.Duplicate
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "Apple"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute
    End With
    Do While .Find.Found
      If .InRange(Rng) = False Then Exit Do
      .Collapse wdCollapseEnd
      .End = .Paragraphs(1).Range.End -1
      DocTgt.Range.Characters.Last.Text = vbCr & .Text
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub

第3页上您感兴趣的内容。

Microsoft Word VBA查找在包含多个页面的文档中的一个指定页面上出现一个单词的次数

1 个答案: