【Word VBA】PDFからWordに変換した際の全角文字間の半角スペースを削除するWordマクロ(その3)

前回の記事「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

関連記事

トップへ戻る