前回の記事「PDFからWordに変換した際の全角文字間の半角スペースを削除するWordマクロ」と「PDFからWordに変換した際の全角文字間の半角スペースを削除するWordマクロ(その2)」の応用版です。
前回のマクロでは文書全体を処理対象にしましたが、今回のマクロではカーソルが置かれている段落を処理対象にします。
私が使うのであれば、範囲選択の手間のかかる「その2」よりもこちらパターンだと思います。段落単位で処理をするのは悪くないなと思います。
何百ページもあるような書類であれば、全体を処理したほうがいいかもしれませんが、内容を確認しながら整えていくのであれば、段落単位で処理をしてもいいかなと思います。
このマクロでできること
カーソルのある段落の全角文字に挟まれた半角スペースを削除します。削除箇所の着色はしません。目視で確認できるからです。
(処理前)
赤矢印の位置にカーソルがあります。この段落が処理対象になります。
(処理後)
カーソルの位置が少しずれました。
マクロの解説
カーソル位置の段落をRangeオブジェクトに取得するために、7行目と10行目を実行しています。「その2」のマクロでは、選択範囲をそのままRangeオブジェクトに設定しましたが、今回のマクロではExpandメソッドを用いて範囲を拡大しています。
それ以外の処理は、他の処理とおおよそ同じです。
マクロ
Sub 全角文字間の半角スペースを削除する_段落() Dim myRange As Range '置換処理用 Dim myInRange As Range '範囲確認用 'カーソル位置(選択範囲)をRangeオブジェクトに設定 Set myRange = Selection.Range 'Rangeオブジェクトを段落に拡大 myRange.Expand wdParagraph 'myRangeの範囲(段落)をmyInRangeに設定する Set myInRange = myRange.Duplicate '置換実行 With myRange.Find .Text = "([! -~^9^11^12^13^14]) ([! -~^9^11^12^13^14])" With .Replacement .Text = "\1\2" End With .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True Do While .Execute = True '見つけた個所が選択範囲内であれば置換実行 If myRange.InRange(myInRange) = True Then .Execute Replace:=wdReplaceOne myRange.Collapse wdCollapseStart Else '見つけた箇所が選択範囲外であれば終了 Exit Do End If Loop End With Set myRange = Nothing Set myInRange = Nothing End Sub