Microsoft Word VBA. Найти количество вхождений слова на одной назначенной странице в документе, содержащем много страниц. - PullRequest
Новая
       6

Microsoft Word VBA. Найти количество вхождений слова на одной назначенной странице в документе, содержащем много страниц.

0 голосов
/ 08 января 2019

Я работаю над созданием кода, который будет использоваться как часть большего набора кодов, который в конечном итоге даст ответ, сколько раз определенное слово появляется на одной указанной странице в документе Word, в котором может быть много страниц.

Что на самом деле пытается выполнить код, так это искать фразу только на одной странице за раз, находить эту фразу, а затем копировать строку сразу после того, где эта фраза была найдена на этой странице, и вставлять строку в другое слово. док. Если вы, кто-либо, можете предложить лучший подход, чем тот, который я изложил ниже, я готов изменить ситуацию, так как это было гораздо более сложной задачей, чем то, что я думал в начале. 

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

1 Ответ

0 голосов
/ 08 января 2019

Возможно, что-то основано на: 

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.

...