前回の記事「PDFからWordに変換した際の全角文字間の半角スペースを削除するWordマクロ」と「PDFからWordに変換した際の全角文字間の半角スペースを削除するWordマクロ（その2）」の応用版です。
前回のマクロでは文書全体を処理対象にしましたが、今回のマクロではカーソルが置かれている段落を処理対象にします。
私が使うのであれば、範囲選択の手間のかかる「その2」よりもこちらパターンだと思います。段落単位で処理をするのは悪くないなと思います。
何百ページもあるような書類であれば、全体を処理したほうがいいかもしれませんが、内容を確認しながら整えていくのであれば、段落単位で処理をしてもいいかなと思います。
＜目次＞
このマクロでできること
カーソルのある段落の全角文字に挟まれた半角スペースを削除します。削除箇所の着色はしません。目視で確認できるからです。
（処理前）
赤矢印の位置にカーソルがあります。この段落が処理対象になります。
（処理後）
カーソルの位置が少しずれました。
マクロの解説
カーソル位置の段落をRangeオブジェクトに取得するために、7行目と10行目を実行しています。「その2」のマクロでは、選択範囲をそのままRangeオブジェクトに設定しましたが、今回のマクロではExpandメソッドを用いて範囲を拡大しています。
それ以外の処理は、他の処理とおおよそ同じです。
マクロ
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | 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 = NothingEnd Sub |