Microsoft Office Forums - View Single Post

jeffreybrown · 12-07-2019, 01:52 PM

I have many table with a title directly above the table. This code below works just fine to add that header as part of the table in the newly created row 1; however, I just ran into a table that has vertically merged cells and therefore throwing an error when running the code.

I know merge cells are not ideal, but in this situation they will have to remain.

Is there a way to access the table even with the merged cells and still add the text above the table as the title in row 1?

In the attachment there is a before and after?

Code:

Sub CleanupTables()
    Dim aTbl    As Table
    Dim aRng    As Range
    Dim aRow    As Row
    
    Application.ScreenUpdating = False
    
    For Each aTbl In ActiveDocument.Tables
        Set aRng = aTbl.Range
        aRng.MoveStart Unit:=wdParagraph, Count:=-1
        aRng.Select
        ActiveWindow.ScrollIntoView aRng, True
        With aTbl                        
            If MsgBox("Does this table have a table name", vbYesNo) = vbYes Then
                Set aRow = aTbl.Rows.Add(BeforeRow:=aTbl.Rows(1))
                aRow.Range.Cells.Merge
                Set aRng = aRng.Paragraphs(1).Range
                aRng.MoveEnd Unit:=wdCharacter, Count:=-1
                aRow.Range.Cells(1).Range.FormattedText = aRng.FormattedText
                aRng.Paragraphs(1).Range.Delete
                aRow.Borders(wdBorderTop).LineStyle = wdLineStyleNone
                aRow.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
                aRow.Borders(wdBorderRight).LineStyle = wdLineStyleNone
                aRow.Range.Style = "Caption"
                aRow.Range.ParagraphFormat.Reset
            End If
        End With
    Next aTbl
            
    Application.ScreenUpdating = True
    
End Sub