【コード】表のセルの末尾に2行追加するWordマクロ

Wordで動く翻訳チェックソフト「色deチェック」のユーザーさんからご要望をいただきまして作ってみました。

色deチェックには対訳表を作成する機能があります。翻訳のチェック時に原文と訳文を左右に並べて比較できます。この対訳表を印刷すると校正作業が楽になります。

ところが、対訳表には修正したときのメモを加入する余白が少ないのです。

そこで、このユーザーさんは、各セルの末尾に2行空の行を手作業で追加して、修正した訳文を記入する余白を設けているとのことでした。

なるほど。いいアイディアです。

というわけで、このアイディアをいただきましてマクロで自動処理をしてみることにしました。

このマクロでできること

現在開かれている文書の最初の表の2列目の各セルを処理対象にします。

このセル内の文章の末尾に空の行を2つ挿入します。

(実行前)

対訳表

(実行後)

対訳表

マクロの解説

訳文が表の2列目に書かれているという前提にしていますので、2列目のセルの末尾に行を挿入します。空の行を挿入する列が2列目ではない場合には、ColNum の数字を変更してください。(5行目)

処理方法はExcelマクロのような表現になっています。行番号を変数 i で設定して、i を1から最大行数(iMax)まで変化させて処理を実行しています。

2行追加をするので、InsertParagraphAfterメソッドを2回繰り返しています。(20行目、21行目)

このように行を追加するようなマクロは、文書全体の配置がずれるので処理時間が比較的かかります。そのため、処理状況を表示するために、StatusBarに処理中の行数を表示します。(24行目)

また、「応答なし」にもなりかねないのでDoEventsメソッドで一呼吸いれるようにしています。(23行目)

マクロ


Sub 表の2列目のセルに行を追加する()

 Dim myTable As Table
 Dim i As Long, iMax As Long '行番号
 Const ColNum As Long = 2 '列番号
 
 '-------------------------------------------
 '前処理
 '-------------------------------------------
 Set myTable = ActiveDocument.Tables(1)
 If myTable.Columns.Count < ColNum Then Exit Sub
 Application.ScreenUpdating = False
 iMax = myTable.Rows.Count
 
 '-------------------------------------------
 '行を追加
 '-------------------------------------------
 For i = 1 To iMax
  With myTable.Cell(i, ColNum).Range
   .InsertParagraphAfter
   .InsertParagraphAfter
  End With
  DoEvents
  Application.StatusBar = i & " / " & iMax
 Next
 
 '-------------------------------------------
 '後処理
 '-------------------------------------------
 Set myTable = Nothing
 Application.ScreenUpdating = True
 Application.StatusBar = "終了しました!"
 
End Sub

トップへ戻る