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

PDFからWordに変換した際に、不要な半角スペースが挿入されてしまうことがあるようです。そのような場合に、一括削除するWordマクロを作ってみました。

先日のサン・フレア アカデミーさんのセミナー受講生からの要望で作成したマクロです。手元にサンプルファイルがないので、セミナー中にいただいた「全角文字間の半角スペースを削除すればよい」というアイディアに基づいてマクロを作成しました。

どうでしょうか?ご利用をいただいてご意見ください!

このマクロでできること

文書全体(ヘッダー、フッター、テキストボックスなどを除く)で、全角文字間の半角スペースを削除します。削除した際に、半角スペースの前後を蛍光ペンの明るい緑で着色します。

ワイルドカードを用いた一括処理をする際には、想定していない個所が処理されることがあるので、このように蛍光ペンで着色するようにしています。

(処理前)

(処理後)

マクロの解説

検索対象を「全角文字と全角文字の間の半角スペース」としています。Wordには「全角文字」に対応する記号が用意されていないので自分で作ります。

私がよく使っているのは、「全角文字を探す方法」の記事で紹介した記述を参考にして以下のように定義します。

全角文字1文字:[! -~^9^11^12^13^14]

これを使ってワイルドカードの検索・置換を行います。

以下のように定義しました。

検索する文字列:([! -~^9^11^12^13^14]) ([! -~^9^11^12^13^14])
置換後の文字列:\1\2

この手のワイルドカードを用いた一括置換では、1回の置換では置換処理が終了しないかもしれない、ということに気を付けましょう。

たとえば、上記の置換を1回実行すると以下のようになります。[検索と置換]ダイアログボックスを使った置換でも同じです。

Wordの置換の特性上、上記のような置換結果になります。対策として、何度か繰り返し置換をする必要があります。

今回のマクロでは置換を2回実行すればいいと思いますが、念のため対象個所がなくなるまで繰り返す処理にしてみました(35行目~38行目のDo Loopステートメント)。

マクロ


Sub 全角文字間の半角スペースを削除する_文書全体()

 Dim myRange As Range
 Dim myColor As Integer
 
 '現在選択されている蛍光ペンの色の保存
 myColor = Options.DefaultHighlightColorIndex
 
 '蛍光ペンの色を設定
 Options.DefaultHighlightColorIndex = wdBrightGreen
 
 '画面更新をオフ
 Application.ScreenUpdating = False
 
 '文書全体をRangeオブジェクトに設定
 Set myRange = ActiveDocument.Range(0, 0)
 
 '置換の実行
 With myRange.Find
  .Text = "([! -~^9^11^12^13^14]) ([! -~^9^11^12^13^14])"
  With .Replacement
   .Text = "\1\2"
   .Highlight = True
  End With
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
  Do While .Execute = True
   .Execute Replace:=wdReplaceAll
   DoEvents
  Loop
 End With
 
 '画面更新をオン
 Application.ScreenUpdating = True
 
 '蛍光ペンの色を元に戻す
 Options.DefaultHighlightColorIndex = myColor
  
 Set myRange = Nothing
 
End Sub

関連記事

全角文字を探す方法

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

トップへ戻る