Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
18 / 306 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【822】蛍光ペンの置き換えが表内で止まる ぱたぱた 17/7/31(月) 15:30 質問[未読]
【823】Re:蛍光ペンの置き換えが表内で止まる 亀マスター 17/8/1(火) 20:20 回答[未読]
【824】Re:蛍光ペンの置き換えが表内で止まる ぱたぱた 17/8/2(水) 12:33 お礼[未読]
【825】Re:蛍光ペンの置き換えが表内で止まる マナ 17/8/9(水) 19:45 発言[未読]
【822】蛍光ペンの置き換えが表内で止まる
質問  ぱたぱた  - 17/7/31(月) 15:30 -
引用なし
パスワード
   はじめまして。Wordマクロ初心者のため要領を得ないかもしれませんが、もしご存じの方がいらっしゃいましたら是非よろしくお願いいたします。

以下のような、黄緑色の蛍光ペンを検索して水色に置き換えるマクロを作成しました。
表の中に蛍光ペンを含まない場合は問題なく置換が完了するのですが、表の中に蛍光ペンを含む場合は蛍光ペンの色が何色か、置換するしないに関係なくそこで動作が止まってしまい、最終的にはWordを強制終了するしかなくなってしまいます。
おそらく表内の蛍光ペンの識別がうまくいかず止まっている（ぱっと見た感じでは無限ループのように見えます）のではないかと思うのですが、解決方法がわかりません。

表内の蛍光ペンは検索しないなどの方法でもかまいませんので、なんとか強制終了することなく置換を終えることはできないでしょうか。

よろしくお願いいたします。

Sub Replace_Color()

　　Selection.Find.ClearFormatting
　　Selection.Find.Highlight = True
　　Selection.Find.Replacement.ClearFormatting
　　Selection.Find.Replacement.Highlight = True
　　With Selection.Find
　　　　.Text = ""
　　　　.Replacement.Text = ""
　　　　.Forward = True
　　　　.Wrap = wdFindStop
　　　　.Format = True
　　　　.MatchCase = False
　　　　.MatchWholeWord = False
　　　　.MatchByte = False
　　　　.MatchAllWordForms = False
　　　　.MatchSoundsLike = False
　　　　.MatchWildcards = False
　　　　.MatchFuzzy = True
　　End With
　　Do
　　　　Selection.Find.Execute
　　　　If Not Selection.Find.Found Then Exit Do
　　　　
　　　　If Selection.Range.HighlightColorIndex = wdBrightGreen Then
　　　　　　Selection.Range.HighlightColorIndex = wdTurquoise
　　　　End If
　　Loop
　　
End Sub
【823】Re:蛍光ペンの置き換えが表内で止まる
回答  亀マスター  - 17/8/1(火) 20:20 -
引用なし
パスワード
   Findを使う際にSelectionを使ったため、1個目の置換後に
カーソル位置（Selection）が置換した範囲の左側に移り、
そこで次の検索を実行するとまた同じものがヒットして・・・
という感じで無限ループになったのだと思われます。

そこで、SelectionではなくRangeオブジェクトのFindを
使うことで解決できると思います。

Sub コード例()

Dim Rng As Range

'Rngの位置を文書の先頭にRangeにセット
Set Rng = ActiveDocument.Range(0, 0)

With Rng.Find
　　.ClearFormatting
　　.Format = True
　　.Highlight = True
　　.Text = ""
　　Do
　　　　If Not .Execute Then Exit Do
　　　　'テーブル以外だけを対象（テーブル内も置換したいならここのIfは不要）
　　　　If Not Rng.Information(wdWithInTable) Then
　　　　　　If Rng.HighlightColorIndex = wdBrightGreen Then
　　　　　　　　Rng.HighlightColorIndex = wdTurquoise
　　　　　　End If
　　　　End If
　　Loop
End With

End Sub
【824】Re:蛍光ペンの置き換えが表内で止まる
お礼  ぱたぱた  - 17/8/2(水) 12:33 -
引用なし
パスワード
   亀マスター 様


ありがとうございます！
Selectionを使用していたせいで無限ループになっていたのですね。
コード例に挙げていただいたようにRangeを使用したら表内も無事、蛍光ペンの色を置き換えることができました。

テーブル以外だけを対象にするコードまで教えてくださりありがとうございます。
本当に勉強になりました。

いろいろと詳細に説明いただきありがとうございました。
【825】Re:蛍光ペンの置き換えが表内で止まる
発言  マナ  - 17/8/9(水) 19:45 -
引用なし
パスワード
   ▼ぱたぱた さん：

解決後ですが、

１)今のコードを修正するなら、次の検索に移る前に
以下を実行すると問題は解決すると思います。
置換マクロではよく使われる手法です。

Selection.Collapse direction:=wdCollapseEnd

また、今のコードはマクロ実行前のカーソルの位置で結果がかわります。
最初にカーソルを文頭に移動させたほうがよいです。

Selection.HomeKey wdStory

２）Rangeオブジェクトを使用する場合でも
無限ループになる場合があります。

なので、同じように、
Rng.Collapse direction:=wdCollapseEnd

を追加しておいたほうが無難かもしれません。


３）色が違う蛍光ペンが連続してあると置換に失敗するそうです。

ht　tp://ameblo.jp/gidgeerock/entry-11012321922.html

以上を踏まえて、わたしの場合はこんな感じにします。

Option Explicit

Sub test()
　　Dim r As Range
　　
　　Set r = ActiveDocument.Range
　　
　　With r.Find
　　　　.Format = True
　　　　.Highlight = True
　　　　Do While .Execute
　　　　　　Do While r.HighlightColorIndex = wdUndefined
　　　　　　　　r.MoveEnd Unit:=wdCharacter, Count:=-1
　　　　　　Loop
　　　　　　If r.HighlightColorIndex = wdBrightGreen Then
　　　　　　　　r.HighlightColorIndex = wdTurquoise
　　　　　　End If
　　　　　　r.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With

End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
18 / 306 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
206458
(SS)C-BOARD v3.8 is Free