VBAを使用して、あるWord文書の文を抽出し、別のWord文書に入れようとしています。したがって、たとえば、組織のタイトルを見つける必要がある場合は、アルゴリズムに従います。
「タイトル」を検索
「タイトル」の後に各文字を(取る)、「アドレス」まで(停止)する
以下は機能しますが、これを行うためのより効率的な方法があるかもしれません:
Sub FindIt()
Dim blnFound As Boolean
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim strTheText As String
Application.ScreenUpdating = False
Selection.HomeKey wdStory
Selection.Find.Text = "Title"
blnFound = Selection.Find.Execute
If blnFound Then
Selection.MoveRight wdWord
Set rng1 = Selection.Range
Selection.Find.Text = "Address"
blnFound = Selection.Find.Execute
If blnFound Then
Set rng2 = Selection.Range
Set rngFound = ActiveDocument.Range(rng1.Start, rng2.Start)
strTheText = rngFound.Text
MsgBox strTheText
End If
End If
'move back to beginning
Selection.HomeKey wdStory
Application.ScreenUpdating = True
End Sub
アクティベートを使用して、できればオブジェクト変数を使用して、ドキュメントを切り替えることができます。
MicrosoftMVPのJayFreedmanは、Selectionオブジェクトなしで作業できるようにこれを親切に修正し、非常にすっきりさせました。
Sub RevisedFindIt()
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
Dim rng1 As Range
Dim rng2 As Range
Dim strTheText As String
Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Title") Then
Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
If rng2.Find.Execute(FindText:="Address") Then
strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
MsgBox strTheText
End If
End If
End Sub
残っている唯一の要件は、このテキストを他のドキュメントに取り込むことです。何かのようなもの:
Documents(2).Range.Text = strTheText
このコードは外部ファイルに書き込みます:
Sub RevisedFindIt_savetofile2 ()
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
'This file will search current document only, the data in open Word document.
Dim rng1 As Range
Dim rng2 As Range
Dim strTheText As String
Dim DestFileNum As Long
Dim sDestFile As String
sDestFile = "C:\test-folder\f12.txt" 'Location of external file
DestFileNum = FreeFile()
'A valid file number in the range 1 to 511,
'inclusive. Use the FreeFile function to obtain the next available file number.
Open sDestFile For Output As DestFileNum 'This opens new file with name DestFileNum
Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Title") Then
Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
If rng2.Find.Execute(FindText:="Address") Then
strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
MsgBox strTheText 'writes string to a message box
Print #DestFileNum, strTheText 'Print # will write to external file with the text strTheText
End If
End If
Close #DestFileNum 'Close the destination file
End Sub
ExcelとWordの両方にRange
オブジェクトがあります。 Excel VBAを使用しているが、Word Range
オブジェクトを参照しようとしているため、変数宣言を修飾して、WordRangeオブジェクトを使用していることをExcelが認識できるようにする必要があります。
Dim rng1 As Word.Range
Dim rng2 As Word.Range
これを発見したChipsLettenの功績
インデックス(2)ではなく、(できれば)他のドキュメントの名前を使用できます。
Documents("OtherName").Range.Text = strTheText
ただし、これによりドキュメント全体のテキストが変更されるため、テキストを挿入する場所に移動する必要があります。
可能であれば、参照できるドキュメント(またはテンプレート)に既存のブックマークがある方がはるかに優れています。
Documents("OtherName").Bookmarks("bkSome").Range.Text = strTheText
幸運を。