Wordテーブルの奇妙な行数

Question

私はVBAスクリプトを作成していますが、2つの単語の間の行数を数えたい場合、奇妙なことが起こります。

テーブルに2つの単語が存在する場合、テーブルへの行数は間違っています。つまり、最初の行は23行目、2行目は17行目、3行目は23行目、4行目は18行目です。 。

私はこのコードを使用します。

Sub delete() 'Eliminar los apartados que no aplican 

    Dim intCurrentLine, toLine, aux As String 

    With ActiveDocument.Content.Find 
     .Text = "[word1]" 
     Do While .Execute(Forward:=True, Format:=True) = True 
      Selection.Find.Execute FindText:=("[word1]") 
      intCurrentLine = Selection.Range.Information(wdFirstCharacterLineNumber) 
      Selection.MoveLeft Unit:=wdWord, Count:=1 
      Selection.Find.Execute FindText:=("[word2]") 
      toLine = Selection.Range.Information(wdFirstCharacterLineNumber) 
      Selection.HomeKey Unit:=wdStory 
      Selection.Find.Execute FindText:=("[word1]") 
      Selection.MoveLeft Unit:=wdWord, Count:=1 

      'Contar paginas, si la pagina si hay mas de una pagina, se recorre la pagina para contar y sumar las lineas. 

      If toLine > intCurrentLine Then 
       Selection.MoveDown Unit:=wdLine, Count:=toLine - intCurrentLine + 1, Extend:=wdExtend 
      Else 
       Selection.GoToNext (wdGoToPage) 
       Selection.MoveEnd wdCharacter, -1 
       aux = Selection.Range.Information(wdFirstCharacter) 
       Selection.HomeKey Unit:=wdStory 
       Selection.Find.Execute FindText:=("[word1]") 
       Selection.MoveLeft Unit:=wdWord, Count:=1 
       Selection.MoveDown Unit:=wdLine, Count:=aux - intCurrentLine + toLine + 1, Extend:=wdExtend 
      End If 
      Selection.delete 
      intCurrentLine = 0 
      fromLine = 0 
     Loop 
    End With 
End Sub 

問題は何ですか？それを修正するために私は何ができますか？

Answer 1

私はあなたの要件を完全にわからないんだけど、あなたのコードを変更している - これを試してみて、それはあなたのために働くなら、私に知らせてください。私は追加

：

Sub delete() 
    Dim rngStart As Range 
    Dim rngEnd As Range 
    Dim rngDelete As Range 

    Dim wordOne As String 
    wordOne = "word1" 
    Dim wordTwo As String 
    wordTwo = "word2" 

    Selection.HomeKey Unit:=wdStory 
    With Selection.Find 
     .Text = wordOne 
     Do While .Execute(Forward:=True, Format:=True) = True 

      Selection.HomeKey Unit:=wdStory 

      Selection.Find.Execute FindText:=(wordOne) 
      Set rngStart = Selection.Range 
      ' At this point the selection = the 'found text'  
      Selection.Collapse wdCollapseEnd ' set range to end of found text 
      Selection.Find.Execute FindText:=(wordTwo) 
      Set rngEnd = Selection.Range 


      Set rngDelete = rngStart.Duplicate 
      'rngDelete.Collapse wdCollapseEnd ' Keep wordOne 
      rngDelete.Collapse wdCollapseStart ' Delete wordOne 
      'rngDelete.End = rngEnd.Start ' Keep wordTwo 
      rngDelete.End = rngEnd.End ' Delete wordTwo 
      rngDelete.Text = " " ' replace rngDelete Text with a space 
      'rngDelete.Text = vbNullString ' replace rngDelete Text with nothing 
     Loop 
    End With 
End Sub 

は注意単語1 & 2が同じページにあるというテストですが、本当にこれが必要かどうかはわかりません。