表の中でのセルの位置を特定する(Word)
表の中でのセルの位置を特定する(Word)
Excelの表に比べて、Wordの表は勝手に改竄されることが今まで少なかったので、完全に油断していた。
Wordで集めた大量のドキュメント。ファイル名の付け方がバラバラなので、整理が大変。そこで、ドキュメント内に記入されている情報を元に、ファイル名をリネームすることにしたのです。たとえば、[会員番号] - [名前].docx
みたいに。
あくまでも急場しのぎのマクロだし、そもそもWordの表に勝手に行や列を挿入するやつもまれだったので、「会員番号」とか「名前」を取得する表のインデックスとか、行番号、列番号なんて決め打ちで十分と思っていた。
しかし、現れやがったんですよ。強者が。
勝手に名前記入欄をすぐ下の表に接着するやつ
とか、
勝手に新しい表を挿入するやつ
なんかが・゜・(ノД`)・゜・。
しかも、一人や二人やない。ちょいちょい処理が止まる……。
とりあえず、その場は応急処置で乗り切ったが、この際なので一般化できるようにWordのTable
オブジェクトについて勉強しておくことにした。
とりあえずキーワードを含むセルを返すFunctionを作る
今回の場合だと、まずは、たとえば、「会員番号」という文字列のあるセルを特定したい。
考え方
で、次のように考えた。
- ドキュメント内の
Table
オブジェクトを全て巡回 Table
オブジェクト内のCell
オブジェクトを総当たりCell
オブジェクトのRange.Text
プロパティがキーワードを含んでいたら、そのCell
オブジェクトを返す
ひとまずこんな感じ。
コード
ドキュメント内の全ての表のセルを巡回して、キーワードがヒットしたらそのセルを返すFunction。
リスト1
Public Function getCell( _ ByVal KeyWord As String, _ Optional ByVal tgtDoc As Document) As Cell Dim ret As Cell Set ret = Nothing '引数tgtDocが省略されていたらActiveDocumentをセット' If tgtDoc Is Nothing Then Set tgtDoc = ActiveDocument End If '全Tableを巡回' Dim tbl As Table For Each tbl In tgtDoc.Tables Set ret = getFoundCell(tbl, KeyWord) If Not ret Is Nothing Then Exit For Next Set getCell = ret End Function 'Table内の全セルを巡回。キーワード見つけ次第return' Private Function getFoundCell( _ ByVal tgtTable As Table, _ ByVal KeyWord As String) As Cell Dim ret As Cell Dim r As Long Dim c As Long Dim tmp As String For r = 1 To tgtTable.Rows.Count For c = 1 To tgtTable.Columns.Count 'Cellオブジェクトを取得' Set ret = tgtTable.Cell(r, c) 'セル内の文字列を取得' tmp = ret.Range.Text '右端のBELと改行コードを除去' tmp = Left(tmp, Len(tmp) - 2) 'キーワードを含んでいたらreturn' If InStr(1, tmp, KeyWord) > 0 Then GoTo Finalizer End If Next Next Set ret = Nothing Finalizer: Set getFoundCell = ret End Function
とりあえずこんな感じ。本当なら、キーワードとセル内文字列の比較について、完全一致とか前方一致とかが選べるようにしたいけれど、ひとまず後回し。
使ってみる
このようなドキュメント(笑)を用意して、次のコードで使ってみる。
リスト2
Private Sub test01() Dim tgtCell As Cell Set tgtCell = getCell("会員番号") Debug.Print tgtCell.RowIndex Debug.Print tgtCell.ColumnIndex End Sub
こいつを実行すると、イミディエイト・ウィンドウに、
このように表示された。
うむ。バッチリである。
ついでにオフセットしたセルを取得するFunctionを作る
Cell
オブジェクトのParent
プロパティを参照すれば、
この画像でおわかりのように、親のTable
オブジェクトを取得することができる。
Cell
オブジェクトからは、表の中での行番号、列番号を返すRowIndex
、ColumnIndex
プロパティがある。
……ということは、ExcelのOffset
プロパティみたいなことができるはずだ。
よーし。作っちゃえ!
考え方
次のような仕様にすれば良い。
Cell
オブジェクトと、行・列それぞれのオフセットサイズを受け取るCell
オブジェクトのParent
プロパティを参照してTable
オブジェクトを取得する- 行・列のオフセットサイズを元に、取得したい
Cell
オブジェクトの表内での位置を求める [Table].Cellメソッドで、取得したい
Cell
オブジェクトを取得する
こんな感じ。
コード
上記のような考え方でコーディングした。
リスト3
Public Function getOffsetCell( _ ByVal tgtCell As Cell, _ ByVal RowOffset As Long, _ ByVal ColumnOffset As Long) As Cell Dim ret As Cell Set ret = Nothing Dim currTable As Table Set currTable = tgtCell.Parent Dim r As Long r = tgtCell.RowIndex + RowOffset 'rの値がおかしくなったらNothingを返す' If r < 1 Then GoTo Finalizer If r > currTable.Rows.Count Then GoTo Finalizer Dim c As Long c = tgtCell.ColumnIndex + ColumnOffset 'cの値がおかしくなったらNothingを返す' If c < 1 Then GoTo Finalizer If c > currTable.Columns.Count Then GoTo Finalizer 'オフセットしたセルを返す' Set ret = currTable.Cell(r, c) Finalizer: Set getOffsetCell = ret End Function
うむ。これで良い。
使ってみる
このドキュメント(笑)から、会員番号を取得して見せよう。
リスト4
Private Sub test02() Dim tgtCell As Cell Set tgtCell = getOffsetCell(getCell("会員番号"), 0, 1) Debug.Print tgtCell.Range.Text End Sub
行オフセットサイズを0
、列オフセットサイズを1
にしているので、一つ右のセル、すなわち会員番号を取得できるはずだ。
こいつを実行すると、イミディエイト・ウィンドウは、
うむ。
さらに、イミディエイト・ウィンドウに
?getOffsetCell(getCell("名前"), 0, 1).Range.Text
と入力して[Enter]を押すと、
うむ。完璧である!!!!!!!!
おわりに
アクロバチック入力に対抗するのはなかなか大変である……orz