スキルアップ・問題解決なら、モーグにおまかせ！

よろしくお願いします。
 
以下のような日本語と英文の２行で１セットの（テキストファイル）をメモ帳ソフトで複数行表示しています。
（テキストファイル）
シンガポールには観光するのにいいところがたくさんあるよ。
There are lots of good places for sightseeing in Singapore.
 
このテキストを２行(1セット)ずつコピーして、
●wordに貼り付ける際、wordテキストボックスを作って、その中に貼り付けます。
さらにテキストボックス内に貼り付けたの２行の
●１行目の日本語の前に"〔意味〕"というテキストを付加して、フォントを"游ゴシック"、サイズを9と設定
●２行目の英文のフォントを”Century”、サイズを13に設定したいと思っています
 
上記を自動化すべく、「マクロの記録」などを使って一応はできたのですが、日本語や英文が長くなった時にバグが発生します。行選択ではなく、段落を選択して操作すべきだと思うのですが、そこがよくわかりません。
ご教示いただけると幸いです。
 
【拙VBA】

Sub tbxSentence()
'貼り付けてフォント操作

    Call tbxSet
    Selection.Paste
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Font.Size = 8
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="〔意味〕"
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Font.Name = "Century Schoolbook"
    Selection.Font.Size = 13
    Selection.EndKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend

    Selection.TypeParagraph
End Sub



Sub tbxSet()
' wrodテキストボックスの作成
'
 Dim tgtDoc As Document  
  Set tgtDoc = ActiveDocument
 
Dim tb As Word.Shape
  Set tb = tgtDoc.Shapes.AddTextbox( _
                           Orientation:=msoTextOrientationHorizontal, _
                           Left:=0, Top:=0, _
                           Width:=450.5276, _
                           Height:=106.0945)

  tb.WrapFormat.Type = wdWrapInline 
  
With tb    
    With .Line 
     'テキストボックスの体裁設定
    End With

    With .TextFrame 
      .TextRange.Select
      .MarginTop = 11
      .MarginBottom = 11
      .MarginLeft = 11
      .MarginRight = 0
      .TextRange.Select
    End With
  End With

End Sub

引用:
日本語と英文の２行で１セットの（テキストファイル）をメモ帳ソフトで複数行表示しています。

引用:
このテキストを２行(1セット)ずつコピー

引用:
wordに貼り付ける際、wordテキストボックスを作って、その中に貼り付けます。

sk様、ご回答とご質問頂きありがとうございます。
 

引用:
「文字列の範囲選択とコピー」はユーザーが手動で行なう、ということでしょうか。
それとも、その部分の操作も含めて自動化したいということでしょうか。

引用:
何故貼り付け先が「テキストボックスの中」なのでしょうか。
そもそも、最終成果物としてどのような Word 文書を作成なさろうとされているのでしょうか。

引用:
横長のテキストボックスが、数ミリの間隔をあけて、word文書内に縦にズラッと並べるイメージ

Sub ConvertTextFileToWordDocument()

    'Microsoft Scripting Rumtime の定数の宣言
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

    Dim strTextFilePath As String
    
    '読み込み対象となるテキストファイルの絶対パスを指定
    strTextFilePath = ThisDocument.Path & "\Examples.txt"

    Dim objFSO As Object            'Scripting.FileSystemObject
    
    'FileSystemObject の新規インスタンスを生成
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'ファイルの有無をチェック
    If objFSO.FileExists(strTextFilePath) = False Then
        '見つからなければエラーメッセージを返す
        MsgBox "指定されたパス'" & strTextFilePath & "'に該当するファイルが見つかりません。", _
               vbExclamation, _
               "ファイル参照エラー"
        Set objFSO = Nothing
        'プロシージャを抜ける
        Exit Sub
    End If
    
    Dim objTextStream As Object     'Scripting.TextStream
        
    'テキストファイルを開く
    Set objTextStream = objFSO.OpenTextFile(FileName:=strTextFilePath, _
                                            IOMode:=ForReading, _
                                            Format:=TristateUseDefault)
                                            
    '空のテキストファイルである場合はプロシージャを抜ける
    If objTextStream.AtEndOfStream Then
        objTextStream.Close
        Set objTextStream = Nothing
        Set objFSO = Nothing
        Exit Sub
    End If
                                            
    Dim docNew As Word.Document
    Dim rngTarget As Word.Range
    Dim lngParagraphCount As Long
    Dim strJapanese As String
    Dim strEnglish As String
    
    'Word 文書の作成処理を呼び出し、作成された文書を参照する
    Set docNew = CreateDocument
                                            
    'テキストファイルの操作
    With objTextStream
        'ファイルポインタが末尾に達するまでループ
        Do Until .AtEndOfStream
            
            '現在の行（奇数行）全体を和訳文として読み込む
            strJapanese = .ReadLine
            
            'ファイルポインタがまだ末尾に達していない場合
            If .AtEndOfStream = False Then
                '更に次の行（偶数行）全体を英文として読み込む
                strEnglish = .ReadLine
            End If
            
            '段落カウンタを1増やす
            lngParagraphCount = lngParagraphCount + 1
            
            '段落カウンタの値、和訳文、英文をイミディエイトウィンドウに出力（デバッグ用）
            Debug.Print lngParagraphCount & vbTab & strJapanese & vbTab & strEnglish
            
            'Word 文書の最後の段落の文字列範囲を参照する
            Set rngTarget = docNew.Paragraphs.Last.Range
            '末尾の改行文字を参照範囲から除外する
            rngTarget.MoveEnd Unit:=wdCharacter, Count:=-1
            'テキストボックスの挿入先として、現在の参照範囲を選択する
            rngTarget.Select
            
            '例文テキストボックスの作成処理を呼び出す
            CreateExampleBox docNew, strJapanese, strEnglish
            
            Set rngTarget = Nothing
            
            '読み込んだ和訳文と英訳を初期化
            strJapanese = ""
            strEnglish = ""
                
            'ファイルポインタがまだ末尾に達していない場合
            If .AtEndOfStream = False Then
                'Word 文書に新しい段落を挿入
                docNew.Paragraphs.Add
            End If
        Loop
    End With
    
    'テキストファイルを閉じる
    objTextStream.Close
    Set objTextStream = Nothing
    Set objFSO = Nothing
    
    docNew.Activate
    
    MsgBox lngParagraphCount & " 組の例文を読み込み、新規文書に挿入しました。", _
           vbInformation, _
           "実行完了"
    
    Set docNew = Nothing

End Sub

-------------------------------------------------------------------------

'Word 文書の新規作成と初期設定を行なう処理
Private Function CreateDocument() As Word.Document

    Dim docNew As Word.Document
    
    'Word 文書の新規作成
    Set docNew = Documents.Add
    
    'スタイル[標準]の操作
    With docNew.Styles(wdStyleNormal)
        'フォントの設定
        With .Font
            .Size = 10.5
            .Name = "游ゴシック"
        End With
    End With
        
    'ページ設定の操作
    With docNew.PageSetup
        '用紙サイズ
        .PaperSize = wdPaperA4
        '用紙の向き
        .Orientation = wdOrientPortrait
        'ページ上余白
        .TopMargin = MillimetersToPoints(20)
        'ページ下余白
        .BottomMargin = MillimetersToPoints(25)
        'ページ左余白
        .LeftMargin = MillimetersToPoints(20)
        'ページ右余白
        .RightMargin = MillimetersToPoints(20)
        '用紙の端からヘッダーまでの距離
        .HeaderDistance = MillimetersToPoints(15)
        '用紙の端からフッターまでの距離
        .FooterDistance = MillimetersToPoints(17.5)
        '1ページ当たりの行数
        .LinesPage = 42
    End With

    '作成した文書への参照を戻り値として返す
    Set CreateDocument = docNew

End Function

-------------------------------------------------------------------------

'例文テキストボックスの作成処理
Private Function CreateExampleBox(Target As Word.Document, JapaneseSentence As String, EnglishSentence As String) As Word.Shape

    Dim tbxNew As Word.Shape

    '横書きテキストボックスの新規作成
    Set tbxNew = Target.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                                          Left:=0, _
                                          Top:=0, _
                                          Width:=MillimetersToPoints(170), _
                                          Height:=MillimetersToPoints(36))
    
    Dim rngJapanese As Word.Range
    Dim rngEnglish As Word.Range
    
    With tbxNew
        
        '[文字列の折り返し]プロパティの設定
        With .WrapFormat
            .Type = wdWrapInline
            .DistanceLeft = 0
            .DistanceTop = 0
            .DistanceRight = 0
            .DistanceBottom = 0
        End With
        
        'レイアウト枠の操作
        With .TextFrame
            '各マージンを設定
            .MarginTop = 11
            .MarginBottom = 11
            .MarginLeft = 11
            .MarginRight = 0
        End With
        
        'レイアウト枠の文字列領域の段落コレクションを操作
        With .TextFrame.TextRange.Paragraphs
            '2つめの段落を追加
            .Add
            '1つめ（和訳文用）の段落の文字列範囲全体を参照する
            Set rngJapanese = .Item(1).Range
            '2つめ（英文用）の段落の文字列範囲全体を参照する
            Set rngEnglish = .Item(2).Range
        End With
    
        '和訳文用の文字列範囲の操作
        With rngJapanese
            'フォントの設定
            With .Font
                'フォントサイズ
                .Size = 9
                '全てのフォント
                .Name = "游ゴシック"
            End With
           '末尾の改行文字を参照範囲から除外する
            .MoveEnd Unit:=wdCharacter, Count:=-1
            '現在の参照範囲の後ろにキャプション"〔意味〕"を挿入
            .InsertAfter "〔意味〕"
            '更に和訳文を挿入
            .InsertAfter JapaneseSentence
        End With
        
        '英文用の文字列範囲の操作
        With rngEnglish
            'フォントの設定
            With .Font
                'フォントサイズ
                .Size = 13
                '英数字のフォント
                .NameAscii = "Century"
            End With
            '末尾の改行文字を参照範囲から除外する
            .MoveEnd Unit:=wdCharacter, Count:=-1
            '現在の参照範囲の後ろに英文を挿入
            .InsertAfter EnglishSentence
        End With
    
        Set rngJapanese = Nothing
        Set rngEnglish = Nothing
    
    End With
    
    '作成したテキストボックスへの参照を戻り値として返す
    Set CreateExampleBox = tbxNew

End Function

以上の 3 つのプロシージャを任意のマクロ有効文書の標準モジュールに貼り付けた上、
ConvertTextFileToWordDocument プロシージャ内の下記赤字の箇所を
適宜書き換えるようにして下さい。
 

引用:
'読み込み対象となるテキストファイルの絶対パスを指定
strTextFilePath = ThisDocument.Path & "\Examples.txt"

sk様、ご回答ありがとうございます。
私にはだいぶ難しいですが、詳しく、合理的であろうプロシージャをご提示いただき、ありがとうございます。

引用:
ConvertTextFileToWordDocument プロシージャ内の下記赤字の箇所を
適宜書き換えるようにして下さい。

引用:
3つのプロシージャをword文書内で、どう実行すればいいかがわかりません。

sk様、
対応が遅く申し訳ございません。
 
できました！！
Sub プロシージャを実行したら、望んだとおりの形、望んだとおりの書体で、テキストボックスが縦にズラッと並びました。文書内で次々テキストボックスが生成される様子は魔法を見ているようで感動しました。当初は意味部分の日本語が文字化けしてしまい、対応に苦慮しましたが、テキストファイルの保存形式を変えることによって文字化けも解消されました。
ありがとうございます。
 
ただ、
実は、同様の英文テキストファイルが複数あり、その都度VBAを書き換えるのも大変だなと思い、ダイアログボックスで選択して、ファイルのパスを選択する方法を考えましたが私には難度が高く･･･、
 
更に、恐縮なのですが
そもそも、テキストファイルから２行ずつWordにコピペするのでなく、
いったん一旦複数行まとめてWordに貼り付けてから、そのWord文書を処理する方が簡単なのかなと思い至りました（今更かよ･･･ですよね。ごめんなさい）
 
「たたき台」という言葉を頂いたので、思いきって質問させて頂くのですが
Word文書内すでにある、「奇数行が日本語(改行)、偶数行が英文(改行)」と続く２０行程度を、まず自分で選択して、それからコマンドを実行して、当事案のように２行ずつテキストボックスに収めて、各行にごとの書式を施すにはどうしたらよいでしょうか？
なお、
●英文・日本文ともときに長文になり、２行を超えてしまうことがあります(改行マークなし)。
●ひとつ目のテキストボックスを出力するのは、選択した２０行の先頭で（選択部分のコピーまたは切り取り後？）
●選択した２０行とは別に、その前後にはWord文書や、同じような横長のWordテキストボックスが存在している可能性がある。
という前提なのですが。
 
何卒宜しくお願い致します。
 

引用:
当初は意味部分の日本語が文字化けしてしまい、対応に苦慮しましたが、テキストファイルの保存形式を変えることによって文字化けも解消されました。

引用:
ダイアログボックスで選択して、ファイルのパスを選択する方法

引用:

    Dim strTextFilePath As String
    
    '読み込み対象となるテキストファイルの絶対パスを指定
    strTextFilePath = ThisDocument.Path & "\Examples.txt"

    Dim strTextFilePath As String
    Dim lngFormat As Long
    
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "テキストファイルの選択"
        .AllowMultiSelect = False
        With .Filters
            .Clear
            .Add "テキスト", "*.txt"
            .Add "Unicode テキスト", "*.txt"
        End With
        If .Show = False Then
            Exit Sub
        End If
        strTextFilePath = .SelectedItems(1)
        If .FilterIndex = 2 Then
            lngFormat = TristateTrue
        Else
            lngFormat = TristateUseDefault
        End If
    End With

    'テキストファイルを開く
    Set objTextStream = objFSO.OpenTextFile(FileName:=strTextFilePath, _
                                            IOMode:=ForReading, _
                                            Format:=lngFormat)

sk様、ご回答ありがとうございます。
 

引用:
既に作成済みのテキストファイルが複数個存在する状況においては、
それぞれのテキストファイルを直接読み込んだ方が簡単ではないでしょうか。

引用:
「ユーザーが手動で任意の文字列を範囲選択する」という要件が
どうしても必須であるのであれば、話は別ですが。

引用:
「範囲選択したい文字列が含まれている Word 文書」と
「テキストボックスの追加先となる Word 文書」が同一である、
ということでしょうか。

引用:
完成した教材にあとから当該テキストボックスを付加する可能性もあります。

引用:
「２行の意味付き英文セット」はすべてを利用するのでなく、選別する必要がある。

引用:
同一のword文書内での処理を想定

引用:
いったん一旦複数行まとめてWordに貼り付けてから、そのWord文書を処理する

'選択中の段落内の文字列範囲を例文テキストボックスに変換する処理
Sub ConvertToExampleBox()

    '選択中の範囲が本文中の文字列範囲ではない場合
    If Selection.Type <> wdSelectionNormal Then
        'プロシージャを抜ける
        Exit Sub
    End If
    
    Dim rngSelected As Word.Range
    Dim lngParagraphsCount As Long
    Dim rngDestination As Word.Range
   
    '選択中の文字列範囲を参照
    Set rngSelected = Selection.Range
    
    'その範囲を段落単位に拡張する
    rngSelected.Expand Unit:=wdParagraph
    
    'その範囲に含まれる全ての段落の操作
    With rngSelected.Paragraphs
        '段落の数を取得
        lngParagraphsCount = .Count
        '最後の段落が「その文書内の最後の段落」である（次の段落がない）場合
        If .Last.Next Is Nothing Then
            '新しい段落を追加
            .Add
            '追加した段落を参照範囲から除外する
            rngSelected.MoveEnd Unit:=wdParagraph, Count:=-1
        End If
        'テキストボックスの挿入先範囲として、次の段落の文字列範囲を参照
        Set rngDestination = .Last.Next.Range
        '始点方向にその範囲の選択を解除（挿入先カーソルを段落の先頭とする）
        rngDestination.Collapse Direction:=wdCollapseStart
    End With
    
    Dim lngParagraphIndex As Long
    Dim rngJapanese As Word.Range
    Dim strJapanese As String
    Dim rngEnglish As Word.Range
    Dim strEnglish As String
     
    '選択範囲内の段落を 2 ずつ進める形でループ
    For lngParagraphIndex = 1 To lngParagraphsCount Step 2
        
        '文字列変数の初期化
        strJapanese = ""
        strEnglish = ""
        
        '現在の（奇数）段落全体の文字列を和訳文として読み込む
        Set rngJapanese = rngSelected.Paragraphs(lngParagraphIndex).Range
        With rngJapanese
            '末尾の改行文字を除外するため
            .MoveEnd Unit:=wdCharacter, Count:=-1
            'プレーンテキストのみ取得
            strJapanese = .Text
        End With
        
        'その次の（偶数）段落全体の文字列を英文として読み込む。
        '但しその段落が「選択された範囲」に含まれていない場合は読み込まない。
        If (lngParagraphIndex + 1) <= lngParagraphsCount Then
            Set rngEnglish = rngSelected.Paragraphs(lngParagraphIndex + 1).Range
            With rngEnglish
                '末尾の改行文字を除外するため
                .MoveEnd Unit:=wdCharacter, Count:=-1
                'プレーンテキストのみ取得
                strEnglish = .Text
            End With
        End If
        
        '挿入先範囲の操作
        With rngDestination
            '新しい段落を挿入し、その段落の文字列範囲を参照する
            Set rngDestination = .Paragraphs.Add.Range
            '始点方向にその範囲の選択を解除する
            .Collapse Direction:=wdCollapseStart
            'その範囲（＝段落の先頭）を Word 上で選択
            .Select
            
            '例文テキストボックスの作成処理を呼び出す
            CreateExampleBox ActiveDocument, strJapanese, strEnglish
            
            '次の挿入先範囲の参照
            Set rngDestination = .Paragraphs.Last.Range
            rngDestination.Collapse Direction:=wdCollapseEnd

        End With
        
        Set rngJapanese = Nothing
        Set rngEnglish = Nothing
        
    Next
    
    '選択範囲全体を削除する（結果、テキストボックスと入れ替わる）
    rngSelected.Delete
    
    Set rngDestination = Nothing
    Set rngSelected = Nothing

End Sub

sk様
長らく、対応できませんで申し訳ございませんでした。
 
お陰様で、願った通りの動作が得られました。
心より感謝申し上げます。
 
言い訳になりますが
2学期に入り多忙を極めており
なかなかお返事できなかったこと
重ねてお詫び申し上げます。