【Word VBA】「○○において」→「in the ○○」に置換するWordマクロ（その3）

2022/10/24 コード 0

先日の「【コード】「○○において」→「in the ○○」に置換するWordマクロ」という記事に書いたプログラムの発展版です。

上記の記事では、プログラムのミスも見つかりましたので、この際なので、間違い探しも楽しんでください。

あと、今回のプログラムの発展版には、水野麻子 さんとyumihen さんからのコメント を参考にさせていただきました。

ありがとうございました。

改良点

①『において』などの日本語部分を残す

前回のバージョンでは、『において』を一括で削除しました。

が、一つ一つ翻訳をしながら削除するほうが、ニュアンスを訳文に生かしやすいと思われますので、一括削除をやめて、色つきの文字で残すことにします。

②「in the 『最初に選択した文字列』」を選択した状態で置換を終了する

以下のような操作になります。（画面はWord 2010です！）

（処理前）

（処理後）

こんな感じの処理です。

③カーソル位置を、「カーソルをsolution直後／において直前」におく

上記②をしない場合の考え方です。

水野さんからご提案いただいた方法です。

（処理後）

ここにカーソルを移動しておけば、カーソルの直後に書かれた「の中において」を削除しやすいですね。

プログラム（１）

改良点①＋②


Sub in_the_solution_3()

　Dim myPhrase(1 To 2) As String
　Dim myRange As Range
　Dim mySearch As String '検索する文字列
　Dim myReplace As String '置換後の文字列
　
　Set myRange = Selection.Range
　
　If Selection.Start = Selection.End Then End
　
　With myRange
　　myPhrase(1) = .Text
　　.Collapse direction:=wdCollapseEnd
　　.MoveEndWhile Cset:="においてける中ので", Count:=6
　　myPhrase(2) = .Text
　End With
　
　myRange.SetRange Start:=Selection.Start, End:=Selection.Start
　
　mySearch = myPhrase(1) & myPhrase(2)
　myReplace = "in the " & myPhrase(1) & myPhrase(2)
　
　With myRange.Find
　　.Text = mySearch
　　.Replacement.Text = myReplace
　　.Replacement.Font.ColorIndex = wdBlue
　　.Forward = True
　　.Wrap = wdFindStop
　　.Execute Replace:=wdReplaceAll
　End With
　
　Selection.End = Selection.End + Len(myReplace) - Len(myPhrase(2))
　
　Set myRange = Nothing

End Sub

プログラム（２）

改良点①＋③

上記プログラムとの違いは、35行目。


Sub in_the_solution_4()

　Dim myPhrase(1 To 2) As String
　Dim myRange As Range
　Dim mySearch As String '検索する文字列
　Dim myReplace As String '置換後の文字列
　
　Set myRange = Selection.Range
　
　If Selection.Start = Selection.End Then End
　
　With myRange
　　myPhrase(1) = .Text
　　.Collapse direction:=wdCollapseEnd
　　.MoveEndWhile Cset:="においてける中ので", Count:=6
　　myPhrase(2) = .Text
　End With
　
　myRange.SetRange Start:=Selection.Start, End:=Selection.Start
　
　mySearch = myPhrase(1) & myPhrase(2)
　myReplace = "in the " & myPhrase(1) & myPhrase(2)
　
　With myRange.Find
　　.Text = mySearch
　　.Replacement.Text = myReplace
　　.Replacement.Font.ColorIndex = wdBlue
　　.Forward = True
　　.Wrap = wdFindStop
　　.Execute Replace:=wdReplaceAll
　End With
　
　Selection.End = Selection.End + Len(myReplace) - Len(myPhrase(2))
　
　Selection.Collapse direction:=wdCollapseEnd
　
　Set myRange = Nothing

End Sub

関連記事

コメント

 

  • 2. Re:ありがとうございます！

    ＞yumihenさん

    どうぞ、お試しください。
    もしうまく動かなかったらまた連絡ください。

    あと、何かインスピレーションあったら、またアイディアをご投稿ください。

    新田順也☆ワードプログラマー返信する

  • 1. ありがとうございます！

    今週は修羅場っていて、なかなかお返事出来ませんでしたm(_ _)m

    すごく発展してきてますね～(@_@)
    早速試させて頂きます

    yumihen

 

トップへ戻る