あるWordの文章中に二重下線があります。その部分を探しマーカーを付け

あるWordの文章中に二重下線があります。その部分を探しマーカーを付けたいと考えています。マクロの記録を使ってみましたがよく解りません。申し訳ありませんがどなたかご教授頂けると助かります。

No.3 ベストアンサー 回答者： enunokokoro 回答日時： 2010/01/29 14:28

マクロ記録ではフォント書式は記録できないので、その部分は追記してください。

一例として

Sub test01()
'
' 検索条件で二重下線、置換条件で蛍光ペン
'
　With Selection.Find
　　.ClearFormatting
　　.Replacement.ClearFormatting
'検索で二重下線
　　.Font.Underline = wdUnderlineDouble
　　.Text = ""
'置換で蛍光ペン
　　.Replacement.Highlight = True
　　.Replacement.Text = "^&"
'その他の条件
　　.Forward = True
　　.Wrap = wdFindContinue
　　.Format = True
　　.MatchCase = False
　　.MatchWholeWord = False
　　.MatchByte = False
　　.CorrectHangulEndings = False
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchWildcards = False
　　.MatchFuzzy = False
　End With

　Selection.Find.Execute Replace:=wdReplaceAll
End Sub

この回答へのお礼

完璧に動きました。
オプションの検索条件は書き足す必要があるのですね。
勉強になりました。ありがとうございました。

お礼日時：2010/01/29 15:39

No.2 回答者： xls88 回答日時： 2010/01/29 14:17

マクロの記録から編集してみました。

とりあえず動きました。
Do Loopを抜ける条件を変数iで設定しています。
もう少し正確な方法を見つけたいです。

Dim i As Long

Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Font.Underline = wdUnderlineDouble
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
End With

Do
i = i + 1
Selection.Find.Execute
Options.DefaultHighlightColorIndex = wdYellow
Selection.Range.HighlightColorIndex = wdYellow
Loop Until i = 100

この回答へのお礼

このマクロだと表の中にある二重下線に入ると止まってしまうようです。
でも一例を有難うございました。

お礼日時：2010/01/29 15:41

No.1 回答者： chonami 回答日時： 2010/01/29 10:58

ワードは書式も置換できますよね。

編集→置換→カーソルを「検索する文字列」へ→オプションをクリック→下の「書式」をクリック→フォントの中で下線から二重下線を選択、OK→置換する文字列へカーソル→書式→蛍光ペンを選択→フォントから二重下線を選択→すべて置換

この回答への補足

ごめんなさい。それはもちろん了解済です。マクロを書きたいのですがわかりますか？

補足日時：2010/01/29 11:20