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

2010年6月19日

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

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

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

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

改良点

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

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

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

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

以下のような操作になります。(画面はWord 2010です!)

(処理前)

(処理後)

こんな感じの処理です。

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

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

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

(処理後)

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

プログラム(1)

改良点①+②


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

プログラム(2)

改良点①+③

上記プログラムとの違いは、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

 

-コード
-