【Word VBA】表内の英数字記号を全角にするWordマクロ(その2)

2017年9月1日

前回の記事「【コード】表内の英数字記号を全角にするWordマクロ(その1)」では、文書中のすべての半角の英数字記号を検索しました。そして、その半角英数字記号が表内にある場合にのみ全角処理をしました。

この方法だと、数百ページの長い文書で表が数個しかない場合、処理対象ではない半角英数字記号ばかりを検索し続けることになります。結果、処理時間がかかってしまいます。

今回の記事では、検索対象を最初から表に限定し、この中にある半角英数字記号を全角化する処理を紹介します。

このマクロでできること

前回の記事と同じです。表内の半角の英数字記号を全角に変換します。

(実行前)

(実行後)

マクロの解説

すべての表を対象にするので、おなじみの For Each ... Next ステートメント を使います。

これで特定した Table オブジェクト を検索対象にする(Rangeオブジェクトにする)ので、myTable というオブジェクト変数のRangeプロパティmyRange に設定します。(18行目)

このmyRange 毎に検索を実行します。myRangeの先頭から検索を実行する処理になっています。今回も前回と同じくワイルドカード(正規表現)を用いて検索します。(21行目)

半角英数字記号が見つかると全角にして、その文字列の直後からまた次の半角英数字記号を検索する手順になっています。

なので、検索された半角英数字記号がmyTable 内に入っているのかを判定する必要があります。

34行目にて、InRange メソッドを用いて上記の判定をしています。myTable内ではない場合には表以外の半角英数字記号を検索したことになるので処理をせずに、次のTable オブジェクトを処理対象にします。

今回の処理でもステータスバーに進捗状況を表示します。

前回は処理対象となる文字列が書かれているページ数を用いて進捗を示しました。今回は、対象となる表が全体の何番目なのかを示して進捗を示します。

以下のように、文書に36の表があり、現在は7番目の表を処理中であると示します。49行目~51行目で処理をしています。

マクロ


Sub 表内の半角英数字記号を全角に変換するWordマクロ2()

 Dim myRange As Range
 Dim myTable As Table
 Dim i As Integer
 Dim iMax As Integer
 
 '画面の更新オフ
 Application.ScreenUpdating = False

 i = 0
 iMax = ActiveDocument.Tables.Count
 
 '1つ1つの表をオブジェクト変数に入れて処理
 For Each myTable In ActiveDocument.Tables
 
  'Rangeオブジェクトで処理を実施
  Set myRange = myTable.Range
  
  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.InRange(myTable.Range) = True Then
     If myRange.Information(wdWithInTable) = True Then
      With myRange
       .HighlightColorIndex = wdBrightGreen
       .CharacterWidth = wdWidthFullWidth
      End With
     End If
     myRange.Collapse wdCollapseEnd
    Else
     Exit Do
    End If
   Loop
  End With

  '進捗状況の表示
  i = i + 1
  Application.StatusBar = i & " / " & iMax
  DoEvents

 Next

 'オブジェクト変数の解放
 Set myRange = Nothing

 '画面の更新オン
 Application.ScreenUpdating = True

End Sub

参考記事

Range.InRange メソッド (Word)

-コード
-, ,