ExcelからVBAでWordを操作する際に、困っています。

□表題の件で、行き詰まっております。
VBA初心者です。試行錯誤している所存です。
Office2016を使用

□仕様
ExcelからVBAを使用し、辞書ファイル(テキスト)とWord(変換対象)を読み込み、
Word文章が、辞書ファイルに存在した際、辞書ファイルに定義された文字列で、
変換する。作成ファイルは、別名で保存します。

■ご質問：どなたかご教授頂けませんでしょうか。
①.Item(i).textで文章を取得する際、何故か、i=2の時に、i=1で取得変換した変換後の文字列が取得され、何故か代入されてしまいます。
⇒これにより、Wordの読み込める個数が1個減ってしまい、最後の文章が変換されない。
②変換後、Wordを開き、見ると、変換文字列の上段に改行(段落?)が、一つ増えてしまう。

□以下が、ソースになります。★印=.Item(i).text部
Public Sub translationExec_Click()
Dim PathName As String '変換元ファイルパス
Dim FileName As String '変換元ファイル名
Dim sExtension As String '元拡張子
Dim postion As Long 'ファイルパス＋ファイル名　分割用ポジション
Dim lFindPoint As Long 'ファイル名　拡張子分割ポジション
Dim sFileStr As String '拡張子を除いたファイル名
Dim ret As Long '重複コピー判定用
Dim lineinfo As String '辞書値データ格納
Dim tmp1 As Variant '辞書値を改行コードで配列とする変数
Dim s As Long '辞書ファイル行数管理
Dim WD As Word.Application 'wordアプリケーションオブジェクト
Dim Selection As Selection 'ワード入力オブジェクト
Dim str() As String '文章格納配列
Dim cnt As Long '文章個数カウント
Dim i As Long '文章個数変数
Dim honyaku As String '辞書値からの取得した翻訳文字列変数

'辞書ファイル指定(PG省略)
'変換元ファイル指定(PG省略)

'パスとファイルを分ける
postion = InStrRev(getchangefileName, "\")
PathName = Left(getchangefileName, postion)
FileName = Mid(getchangefileName, postion + 1)
'文字列の右端から"."を検索し、左端からの位置を取得する
lFindPoint = InStrRev(FileName, ".")
'拡張子を除いたファイル名の取得
sFileStr = Left(FileName, lFindPoint - 1)
'元拡張しを取得
sExtension = Mid(FileName, lFindPoint)
'変換後ファイル名生成
copyfileName = sFileStr + "_変換後" + sExtension
'変換後ファイルフルパス
copyfilePath = PathName + copyfileName

'ファイルの重複コピー確認(PG省略)

'ファイルコピー
FileCopy getchangefileName, copyfilePath

With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile getdictionaryFileName
lineinfo = .ReadText
.Close
End With

'行(改行)毎に配列に格納
tmp1 = Split(lineinfo, vbLf)

'変換対象ドキュメントを指定
Set WD = CreateObject("Word.Application")

'文書を開く
With WD.Documents.Open(copyfilePath)
With .Sentences
'文章として取得
cnt = .Count
'動的配列(文章カウント分)
ReDim str(1 To cnt)
For i = 1 To cnt
'Word取得文章を配列に格納
str(i) = .Item(i).Text '★
'変換ファイルカウント変数
s = 1
'1を指定で、変換テキストのヘッダを除き、処理
For s = 1 To UBound(tmp1)
'Word取得センテンス変数に改行位置が0(一番左側)でない場合＝文字≒文章有りの場合
If InStr(str(i), vbCr) > 0 Then
'辞書からの抽出でにヒットした場合
'※Word　str(i)には改行コード(vbCr)も含まれる場合は、省いた形で比較
If InStr(tmp1(s), Left(str(i), InStr(str(i), vbCr) - 1)) = 1 Then
'タブを挟んだ変換語を抽出
honyaku = Replace(Mid(tmp1(s), InStr(tmp1(s), vbTab), Len(tmp1(s))), vbTab, "")
With WD.Selection.Find
.Forward = True
.ClearFormatting
.Text = Left(str(i), InStr(str(i), vbCr))
With .Replacement
.ClearFormatting
.Text = LTrim(honyaku)
End With
.Execute Replace:=wdReplaceOne
End With
WD.Selection.TypeParagraph 'これを入れないと1行目しか変換されない
honyaku = ""
Exit For
End If
End If
Next s
Next i
End With
.Close '文書閉じる
End With
WD.Quit 'プロセスを閉じる
Set WD = Nothing 'オブジェクト解放
MsgBox "完了", vbInformation, "翻訳変換"
End Sub

質問者からの補足コメント

• 

  tatsu99様
  ご指摘ありがとうございます。以下にご返答致します。
  １）以下の前提で良いですか。
  ご認識の通りです。
  
  ２）辞書ファイルのフォーマットが不明
  ・テキストファイルで言語と訳語の間はタブ区切り(utf-8)
  ・VBA側の検索時は、ヘッダ行の次の行から検索します。
  ・Word文書から、文章としても単語としても翻訳ができるように辞書に登録します。
  例)
  原語　訳語 ←ヘッダ
  りんご　apple ←明細
  私は、リンゴを持っています。　I hava a apple. ←明細
  
  ３）Wordをどのように置換したいのかが不明
  word文書内をSentence(文章≒改行)として取得し、
  取得した値をそのまま辞書ファイルから検索し、
  位置などもそのまま置換したいです。
  
  お忙しい中、ご返信すごくうれしく思います。よろしくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/01/25 16:04

No.1 回答者： tatsu99 回答日時： 2017/01/25 15:52

補足要求です。

１）以下の前提で良いですか。
getdictionaryFileName　には辞書ファイルの完全パスが設定されている。
getchangefileName　にはWordファイルの完全パスが設定されている。

２）辞書ファイルのフォーマットが不明
1行　単語1<タブ>単語1の説明
2行　単語2<タブ>単語2の説明
3行　単語3<タブ>単語3の説明
のような形式であってますか。

３）Wordをどのように置換したいのかが不明
wordの文章が

単語1・・・・単語2・・・・
単語3・・・・単語4・・・・

のようになっていたとすると、

単語1の説明・・・・単語2の説明・・・・
単語3の説明・・・・単語4の説明・・・・

のように置換すれば良いのですか。

No.2 ベストアンサー 回答者： tatsu99 回答日時： 2017/01/26 16:38

辞書の中には、１行は

変換前文章<タブ>変換後文章
のように格納されている前提です。

dim tmp2 as variant '辞書を変換前文章と変換後文章とに分けて格納
上記変数を追記します。

変更点は、以下の通りです。
------------------------------
'行(改行)毎に配列に格納
'-----------ここから修正開始------------------
tmp1 = Split(lineinfo, vbCrLf)
'最後の要素が空白ならその要素を削除する
If tmp1(UBound(tmp1)) = "" Then
ReDim Preserve tmp1(UBound(tmp1) - 1)
End If
'変換対象ドキュメントを指定
Set WD = CreateObject("Word.Application")

'文書を開く
With WD.Documents.Open(copyfilePath)
With .Sentences
'文章として取得
cnt = .Count
'動的配列(文章カウント分)
ReDim str(1 To cnt)
For i = 1 To cnt
'Word取得文章を配列に格納
str(i) = .Item(i).Text '★
'1を指定で、変換テキストのヘッダを除き、処理
For s = 1 To UBound(tmp1)
'辞書を変換前文章と変換後文章とに分ける
tmp2 = Split(tmp1(s), vbTab)
'Word取得センテンス変数に改行位置が0(一番左側)でない場合＝文字≒文章有りの場合
If InStr(str(i), vbCr) > 0 Then
'辞書の変換前文章がヒットした場合、変換後文章で置換する
If InStr(str(i), tmp2(0)) > 0 Then
With WD.Selection.Find
.Forward = True
.ClearFormatting
.Text = tmp2(0)
.Wrap = wdFindContinue
With .Replacement
.ClearFormatting
.Text = tmp2(1)
End With
.Execute Replace:=wdReplaceOne
End With
Exit For
End If
End If
Next s
Next i
End With
.Close '文書閉じる
End With
'------------ここまで修正--------------------
WD.Quit 'プロセスを閉じる
Set WD = Nothing 'オブジェクト解放
MsgBox "完了", vbInformation, "翻訳変換"
------------------------------

一応、簡単に変更点を述べますと
tmp1 = Split(lineinfo, vbCrLf)
は、vbLfでなくvbCrLfで分割します。Windowsの改行コードはCR,LFです。
改行コードが行の終端にあるので、一番最後が、データなし（0バイトのデータ）になる場合が
あるので、その場合、最後の要素を削除します。

Wordの文章の中に、辞書の変換前の文章があれば、それを変換後の文章で置換します。
検索時、.Wrap = wdFindContinueを追加しました。これがないと、２回目以降の検索で失敗します。

文章へ余分な行を増やすので、下記の文は削除しました。
WD.Selection.TypeParagraph 'これを入れないと1行目しか変換されない

strは配列で確保する必要はありませんが、このままでも実害はないので、そのままにしてあります。

以下の文は、意味がないので削除しました。
'変換ファイルカウント変数
s = 1

問題点
このプログラムで、文章単位に変更前の文章を検索しているが、実際の検索・置換はWord全体
を対象にしています。従って、ヒットするものが２つ以上あった場合は、その文章でなく、別の箇所の
文章が置換されることがあります。この解決のためには、根本的な見直しが必要になりますが、
今回は、これが、問題になるかどうかがまだわかりませんので、このままとします。

この回答へのお礼

tatsu99様

解説までわかりやすくありがとうございました。
余分な事や、根本的な認識に謝りが多々あり、
問題だったようですね。
ありがとうございます。

問題点まで、ありがとうございます。
再度、この解答を盛り込み、問題点についても検討いたします。

非常に助かりまして、嬉しく思います。

お礼日時：2017/01/26 17:02