【コード】表中の結合されたセルを着色するWordマクロ(その2)

2017年10月25日(追記)
誤りがあったため修正しました。
【コード】表中の結合されたセルを着色するWordマクロ(その3)

Wordで動く翻訳チェックソフト「色deチェック」でチェックをする場合、結合セルがあるとエラーが発生してしまいます。色deチェックのユーザーの方から本件の問い合わせがありました。ご指摘をありがとうございます。

色deチェックが作成する表には結合セルはないのですが、ほかのツールで作成した表やExcelで編集した対訳表の場合、ときどき結合セルが混ざってしまうようです。

そこで、表内の結合セルを判定する仕組みを作ってみました。次のアップデートで本機能を実装します。

以前の記事「【コード】表中の結合されたセルを着色するWordマクロ 」にて結合セルを判定して着色するコードを紹介しましたが、これは処理が遅いので数千行の表になった場合に実用性が低いと感じます。

今回のものは2行の表に限定することで処理速度を向上させました。

このマクロでできること

結合セルを黄色で着色します。2列の表に限定して使ってください。

実行前

実行後

マクロの解説

表の判定なので、いつもの For Each… Next ステートメントを使い文書中のTable オブジェクトに対して判定処理をします。

セルの結合の判定を、セルを1つ1つ探したときにそのセルが存在しているのか否かで判断するようにしました。

なので、各行の1列目のセルをmyCell1のCellオブジェクト変数、2列目のセルをmyCell2のCellオブジェクト変数に設定し、この設定処理ができない場合(つまり、対象のセルが存在していない場合)に発生するエラーを判定材料にしました。

1列目のセルが存在しない場合は、1行上のセルと結合している場合です。

2列目のセルが存在しない場合は、1行上のセルと結合している場合と同じ行の1列目のセルと結合している場合の2パターンです。

なので、それを踏まえた処理になっています。

33行目で使っている判定には、【コード】表の特定の行の列数を調べるWordマクロ で紹介した「特定の行の列数を調べる」方法(Information(wdMaximumNumberOfColumns) プロパティ)を用いています。

マクロ


Sub セルの結合を判定する2()

 '2列の表の結合セルを判定
 
 Dim myTable As Table
 Dim i As Integer
 Dim myCell1 As Cell '1列目のセル
 Dim myCell2 As Cell '2列目のセル
 
 On Error Resume Next
 
 '-------------------------------------------
 '画面の更新をオフ
 '-------------------------------------------
 Application.ScreenUpdating = False
 
 For Each myTable In ActiveDocument.Tables
  If myTable.Uniform = False Then
   For i = 1 To myTable.Rows.Count
    '-------------------------------------------
    'i行目の1列目のセルの存在確認
    '-------------------------------------------
    Set myCell1 = myTable.Cell(i, 1)
    If Err <> 0 Then
     myCell2.Range.Previous(wdCell).Shading.BackgroundPatternColorIndex = wdYellow
     Err.Clear
    End If
    '-------------------------------------------
    'i行目の2列目のセルの存在確認
    '-------------------------------------------
    Set myCell2 = myTable.Cell(i, 2)
    If Err <> 0 Then
     If myCell1.Range.Information(wdMaximumNumberOfColumns) = 1 Then
      myCell1.Range.Shading.BackgroundPatternColorIndex = wdYellow
     Else
      myCell1.Range.Previous(wdCell).Shading.BackgroundPatternColorIndex = wdYellow
     End If
     Err.Clear
    End If
   Next
  End If
 Next

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

End Sub

関連記事

【コード】表の特定の行の列数を調べるWordマクロ

トップへ戻る