2017/09/01 関連記事を投稿しました。 【コード】表内の英数字記号を全角にするWordマクロ（その２）
先日のWordマクロセミナー（超入門編）に参加をいただいた参加者からいただいた要望です。
この方の仕事では、表内にある英数字記号をすべて全角にする必要があるらしく、いつも手作業で表を探して英数字記号を全角にされているとか。
それをWordの機能かWordマクロを使って一括でできないでしょうか、という問い合わせでした。
最初はWordの［検索と置換］ダイアログボックスだけでできるのかなと思ったのですが、やはり難しそうです。Wordマクロを作ってみました。
表内の文字列だけを処理する考え方の一つとして紹介します。
このマクロでできること
表内の半角の英数字記号を全角に変換します。
（実行前）
（実行後）
マクロの解説
検索された半角英数字記号が表内であることを判定し、表内の場合にだけその文字列に対して処理をするという手順になっています。
検索する文字列をワイルドカード（正規表現）を用いて指定します。（14行目）
[\!-~]{1,}
見つけた文字列が表内であるかどうかの判定は、以下の記述を使います。（28行目）
If myRange.Information(wdWithInTable) = True Then
ステータスバーで進捗状況を表示します。今回のケースのように、半角英数字記号が表内にいくつあるのかわからない場合、処理がいつ終わるのか予想がつきません。
そうすると急ぎの場合に落ち着かないので、進捗状況を表示するといいですね。
このような場合、ページ番号を用いて進捗状況を示すとよいと思います。つまり、文書の先頭から処理を開始し、処理対象として見つけた半角英数字記号が書かれたページ番号と総ページ数を比較して進捗状況を示すわけです。（39行目～42行目）
処理をすることで総ページ数が変化しうる場合には、総ページ数を毎回計算し直します。その必要がない場合には最初に1回だけ総ページ数を計算すればよいと思います。
ループの最後にDoEvents関数を用いました。
Wordマクロで文字列を1つ1つ処理する場合、Wordが息切れをして「応答なし」のいやーな状況になりがちです。このような状況を回避するためにDoEvents関数を使います。
Wordに息継ぎをさせるようなイメージになるので処理速度が遅くなりますが、「応答なし」を回避できるので我慢してください。
マクロ
Sub 表内の半角英数字記号を全角に変換するWordマクロ()
Dim myRange As Range
Dim i As Long
Dim iMax As Long
'画面の更新オフ
Application.ScreenUpdating = False
'検索・変換処理
Set myRange = ActiveDocument.Range(0, 0)
With myRange.Find
.Text = "[\!-~]{1,}"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWholeWord = False '完全に一致する単語だけを検索する
.MatchAllWordForms = False '英単語の異なる活用形を検索する
.MatchSoundsLike = False 'あいまい検索（英）
.MatchFuzzy = False 'あいまい検索（日）
.MatchByte = False '半角と全角を区別する
.MatchCase = False '大文字と小文字の区別する
.MatchWildcards = True 'ワイルドカードを使用する
Do While .Execute = True
'全角化処理
If myRange.Information(wdWithInTable) = True Then
With myRange
.HighlightColorIndex = wdBrightGreen
.CharacterWidth = wdWidthFullWidth
End With
End If
'対象を解除
myRange.Collapse wdCollapseEnd
'ステータスバーに進捗状況を表示
i = myRange.Information(wdActiveEndPageNumber)
iMax = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
Application.StatusBar = i & " / " & iMax
DoEvents
Loop
End With
Set myRange = Nothing
'画面の更新オン
Application.ScreenUpdating = True
End Sub
