バックストーリー:検索結果をWebサイトからWordにコピーして貼り付けています。貼り付けたテキストは、次の画像のようになります。
目標:検索結果の各セット(緑色で表示)から2行だけが必要です。他のすべてを削除する必要があります。 (何百もの検索結果がある場合は非常に面倒です)。赤の最初の単語で始まり、次のサムネイル画像で終わる文字列を定義したいと思います。それからそれを削除したいと思います。
朗報:赤の最初の単語は常に同じです。これを「ファースト」と呼びます。
私の問題:検索結果の数は常に変化するため、画像で終わる範囲を定義することを考える唯一の方法は、から始めることです。ドキュメントの終わりと後処理。最後の写真から始めたい
ActiveDocument.InlineShapes(ActiveDocument.InlineShapes.Count)
次に、この画像から逆方向に「First」というテキストを検索します。そのWordの最初の出現を見つけたら、最後の画像とそのWordを使用して範囲を作成し、削除できるようにします。これを行う方法がわかりません。
これまでの進捗状況:これが私がこれまでに持っているものです:今のところ、それはテキスト「最初」を前方に検索します。これを元に戻すにはどうすればよいですか?
Sub Clear_Stuff()
Dim blnFound As Boolean
Dim Pic As Range
Dim First As Range
Dim rngFound As Range
Dim LastPic As InlineShape
Set LastPic = ActiveDocument.InlineShapes(ActiveDocument.InlineShapes.Count)
Application.ScreenUpdating = True
'=====================================================================================
' Selects the last picture on the document, moves the selection to the right once,
' and sets variable Pic to that selection
'-------------------------------------------------------------------------------------
LastPic.Select
Selection.MoveRight wdWord
Set Pic = Selection.Range
'======================================================================================
' searches for the text "First", moves the selection to the left once
' and sets variable First to that selection
' then it sets the range variable rngFound with Pic and First as its bounds
'--------------------------------------------------------------------------------------
Selection.Find.Execute FindText:="First", Forward:=False
blnFound = Selection.Find.Execute
If blnFound Then
Selection.MoveLeft wdWord
Set First = Selection.Range
Set rngFound = ActiveDocument.Range(First.Start, Pic.Start)
End If
'========================================================================
' Deletes the range
'------------------------------------------------------------------------
rngFound.Select
Selection.Delete
Application.ScreenUpdating = True
End Sub
私は確かにこれが明確であることを願っています。誰かが求めるかもしれない説明を追加させていただきます。私はVBAの初心者です。これを最後の検索結果で機能させることができたら、このマクロをループして結果のセット全体を処理します。
助けてくれてありがとう!
Sub DeleteLastOccurence()
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="Hello", Forward:=False
If myRange.Find.Found = True Then myRange.Delete
End Sub
重要な部分はForward:=False
VBAに逆方向に検索するように指示する場所
このコードは、最後の画像を検索します。次に、逆方向に戻ってキーワードの最初の出現を検索します(この例ではFirst)。次に、キーワードと画像の間の範囲を選択します。削除するなど、好きなことをすることができます。
Sub DeleteLastOccurence()
Dim rngPicture As Range
Dim rngJunk As Range
Set rngPicture = ActiveDocument.InlineShapes(ActiveDocument.InlineShapes.Count).Range
Set rngJunk = Range(0, rngPicture.Start)
rngJunk.Find.Execute FindText:="First", Forward:=False
If rngJunk.Find.Found = True Then Range(rngJunk.Start, rngPicture.Start).Select
End Sub
私の完成品をお見せするためだけに:
まず、マクロは最初の画像(ドキュメントの上部)を削除します。これにより、ループがドキュメントの先頭に達したときにエラーが発生するようになります
次に、あなたが私を助けてくれたことを実行し、エラーが発生するまで(つまり、別の画像を見つけることができないまで)永久にループします。その時点で、マクロは終了します。
Sub DeleteLastOccurence()
On Error GoTo GetOut
ActiveDocument.InlineShapes(1).Delete
Do
Dim rngPicture As Range
Dim rngJunk As Range
Set rngPicture = ActiveDocument.InlineShapes(ActiveDocument.InlineShapes.Count).Range
Set rngJunk = ActiveDocument.Range(0, rngPicture.Start)
rngJunk.Find.Execute FindText:="KeyWord", Forward:=False
If rngJunk.Find.Found = True Then ActiveDocument.Range(rngJunk.Start, rngPicture.End).Select
Selection.Delete
Loop While 1 + 1 = 2
GetOut:
End Sub
「1+ 1 = 2の間にループする」以外に、ループを永遠に続けるように指示するより良い方法があると確信しています。しかし、それでうまくいくと思いました。笑。
再度、感謝します!