Microsoft Office Forums - View Single Post

Guessed · 12-19-2022, 11:38 PM

Any query on .Rows will throw an error if there are vertical merges. Similarly, .Columns will error if there is a horizontal merge. Perhaps this is what you are trying to do

Code:

Sub InsertTableTags()
  Dim tbl As Table, aCell As Cell
  Dim iRow As Integer, iCol As Integer, iRows As Integer
  
  ' Loop through all tables in the document
  For Each tbl In ActiveDocument.Tables
    iRows = tbl.Rows.Count
    For Each aCell In tbl.Range.Cells
      iRow = aCell.RowIndex
      iCol = aCell.ColumnIndex
      Debug.Print iRow, iCol, aCell.Range.Words(1)
      Select Case iRow
        Case 1
          'do nothing
        Case 2
          'If aCell.Next.RowIndex <= iRow Then    'not sure if you want to manage merged
            aCell.Range.InsertBefore Text:="<TC>"
          'End If
        Case iRows    'last row only
          If aCell.Range.Text Like "*Source*" Or aCell.Range.Text Like "*Note*" Then
            aCell.Range.InsertBefore Text:="<TTS>"
          Else
            aCell.Range.InsertBefore Text:="<TTL>"
          End If
        Case Else  'not first, second or last row
          aCell.Range.InsertBefore Text:="<TT>"
      End Select
    Next aCell
  Next tbl
End Sub