View Single Post
 
Old 12-19-2022, 02:58 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Your code is only touching the first cell in a row. You need a loop there if you want to touch every cell in a row. For example
Code:
Sub InsertTableTags()
  Dim tbl As Table, rng As Range, row As row, aCell As Cell
  
  ' Loop through all tables in the document
  For Each tbl In ActiveDocument.Tables
    Set rng = tbl.Range
    If tbl.Rows(2).Cells.Count > 1 Then    ' Check if all columns are merged
      rng.Cells(1).Range.InsertBefore Text:="<TC>"        ' Insert <TC> in first row
    End If
  
    ' Loop through rows in the table
    For Each row In tbl.Rows
      Set rng = row.Range
      If row.Index = 2 Then   ' Check if current row is the second row
        If tbl.Rows(2).Cells.Count > 1 Then     ' Check if all columns are merged
          rng.Cells(1).Range.InsertBefore Text:="<TCH>" ' Insert <TCH> in second row
        End If
   
      ElseIf row.Index > 2 And row.Index < tbl.Rows.Count Then   ' Check if current row is not the first or last row
        For Each aCell In row.Cells
          aCell.Range.InsertBefore Text:="<TT>"    ' Insert <TT> in all cells
        Next aCell
   
      ElseIf row.Index = tbl.Rows.Count Then   ' Check if current row is the last row
        If tbl.Rows(tbl.Rows.Count).Cells.Count > 1 Then     ' Check if all columns are merged
          rng.Cells(1).Range.InsertBefore Text:="<TTL>"        ' Insert <TTL> in last row
        End If
      
        ' Check if "Source", "Notes", or "Note" is found in the last row
        If InStr(rng.Text, "Source") > 0 Or InStr(rng.Text, "Notes") > 0 Or InStr(rng.Text, "Note") > 0 Then
          rng.Cells(1).Range.InsertBefore Text:="<TTS>"    ' Insert <TTS> in all cells of the last row
        End If
      End If
    Next row
  Next tbl
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote