ワードでマクロがうまくいきません。

質問

よろしくお願いします。

マクロの知識はほとんどないのですが、
「マクロの記録」の機能を使い、ワードで
「スペースを探し出し、そのスペースにアンダーラインを引く。」
ために、
--------------------
編集ー置換ー
検索する文字列にスペースをタイプ、
置換後の文字列にスペースをタイプ、
オプションの書式で、フォント、下線、一重下線
すべて置換
--------------------
マクロの記録を選択した後、上のように作業しました。
そしてマクロの記録をとめました。
マクロの記録中の操作では、思い通りに置換されるのですが、
次にそのマクロを作動させると、なにもおこりません。
なにか変な操作をしたのか、と五度くらい試したのですが、
やはり動きません。

中身は、↓のようでした。
--------------------
Sub Macro2()
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "　"
.Replacement.Text = "　"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

--------------------
どうしてうまく動かないのでしょうか。
教えていただけるとありがたいです。よろしくお願いします。

回答No.1

enunokokoro · ベストアンサー

こちら↓のNo.1で回答されていることが理由ですね。
マクロ記録された内容は、オプションで指定した書式の情報を記録して
いないので、スペースをスペースで置換しているだけの内容です。
紹介している先と同じように希望のものに書き換えると、以下のように
なります。

Sub Space_UnderlineSingle()
'
'全角スペースに一重下線を設定
'
　With ActiveDocument.Content.Find
　　.ClearFormatting
　'検索する文字列を全角スペースで指定
　　.Text = "　"
　　.Wrap = wdFindContinue
　　With .Replacement
　　　.ClearFormatting
　'置換後の文字列を全角スペースで指定
　　　.Text = "　"
　'フォントの下線で一重下線を指定
　　　.Font.Underline = wdUnderlineSingle
　'フォントの下線の色を"自動"で指定
　　　.Font.UnderlineColor = wdColorAutomatic
　　End With
　　　.Execute Replace:=wdReplaceAll
　End With
End Sub

下線の色を指定したいなら" wdColorRed "のように書き換えます

お礼

enunokokoroさま、
早速ご回答いただき、ありがとうございました。
今、コピーして、作動させたら、うまく変換してくれました。

素人なので困っていましたが、大変助かりました。
ありがとうございました。