表の中でのセルの位置を特定する(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

とりあえずこんな感じ。本当なら、キーワードとセル内文字列の比較について、完全一致とか前方一致とかが選べるようにしたいけれど、ひとまず後回し。

使ってみる

f:id:akashi_keirin:20200602081307j:plain

このようなドキュメント(笑)を用意して、次のコードで使ってみる。

スト2
Private Sub test01()
  Dim tgtCell As Cell
  Set tgtCell = getCell("会員番号")
  Debug.Print tgtCell.RowIndex
  Debug.Print tgtCell.ColumnIndex
End Sub

こいつを実行すると、イミディエイト・ウィンドウに、

f:id:akashi_keirin:20200602081310j:plain

このように表示された。

うむ。バッチリである。

ついでにオフセットしたセルを取得するFunctionを作る

CellオブジェクトのParentプロパティを参照すれば、

f:id:akashi_keirin:20200602081313j:plain

この画像でおわかりのように、親のTableオブジェクトを取得することができる。

Cellオブジェクトからは、表の中での行番号、列番号を返すRowIndexColumnIndexプロパティがある。

……ということは、ExcelOffsetプロパティみたいなことができるはずだ。

よーし。作っちゃえ!

考え方

次のような仕様にすれば良い。

  • 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にしているので、一つ右のセル、すなわち会員番号を取得できるはずだ。

こいつを実行すると、イミディエイト・ウィンドウは、

f:id:akashi_keirin:20200602081316j:plain

うむ。

さらに、イミディエイト・ウィンドウに

?getOffsetCell(getCell("名前"), 0, 1).Range.Text

と入力して[Enter]を押すと、

f:id:akashi_keirin:20200602081602j:plain

うむ。完璧である!!!!!!!!

おわりに

アクロバチック入力に対抗するのはなかなか大変である……orz