#1
|
|||
|
|||
insertbefore in all cells and columns
Code:
Sub InsertTableTags() Dim tbl As Table Dim rng As Range Dim row As row ' Loop through all tables in the document For Each tbl In ActiveDocument.Tables Set rng = tbl.Range ' Check if all columns are merged If tbl.Rows(2).Cells.Count > 1 Then ' Insert <TC> in first row rng.Cells(1).Range.InsertBefore Text:="<TC>" End If ' Loop through rows in the table For Each row In tbl.Rows Set rng = row.Range ' Check if current row is the second row If row.Index = 2 Then ' Check if all columns are merged If tbl.Rows(2).Cells.Count > 1 Then ' Insert <TCH> in second row rng.Cells(1).Range.InsertBefore Text:="<TCH>" End If ' Check if current row is not the first or last row ElseIf row.Index > 2 And row.Index < tbl.Rows.Count Then ' Insert <TT> in all cells rng.Cells(1).Range.InsertBefore Text:="<TT>" ' Check if current row is the last row ElseIf row.Index = tbl.Rows.Count Then ' Check if all columns are merged If tbl.Rows(tbl.Rows.Count).Cells.Count > 1 Then ' Insert <TTL> in last row rng.Cells(1).Range.InsertBefore Text:="<TTL>" 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 ' Insert <TTS> in all cells of the last row rng.Cells(1).Range.InsertBefore Text:="<TTS>" End If End If Next row Next tbl End Sub |
#2
|
||||
|
||||
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 |
#3
|
|||
|
|||
Thanks, one more help
For span cells and vertically merge cells. How can we check.
for Example file attached |
#4
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
sorting cells in excel into specific columns | oscarlimerick | Excel | 6 | 05-11-2022 07:26 AM |
Problem with merged cells and row height in adjacent two- and three-row columns | rolandoftheeld | Word Tables | 3 | 08-31-2018 03:55 PM |
Relating cells in a row in one sheet to cells in columns on another sheet. | mbesspiata3 | Excel | 2 | 01-06-2017 05:42 AM |
Insertbefore an array? help :( | n00bie-n00b | Word VBA | 21 | 08-21-2014 08:03 PM |
How to merge two columns & replace contents of cells conditionally? | mag | Excel | 3 | 10-24-2012 01:07 PM |