2017年10月25日（追記） 誤りがあったため修正しました。 【コード】表中の結合されたセルを着色するWordマクロ（その３）
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
関連記事