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

2021年7月7日

, , ,

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）

-コード
-, , ,