View Single Post
 
Old 09-10-2025, 01:00 PM
amankap amankap is offline Windows 10 Office 2021
Novice
 
Join Date: May 2024
Posts: 9
amankap is on a distinguished road
Default Issue with Table Header Row Persistence when using VBA macro

Hi,

I am reaching out regarding an issue with exporting Confluence content to MS Word.

The Confluence exporter does not appear to support transferring more than one table header row.

To work around this, I have developed a VBA macro that scans for rows marked with the <HDR> tags in the first cell of a table row (in Confluence) and converts any such rows into header rows. In addition of marking them as header rows, the macro also removes the <HDR> tag from MS-Word content. This works perfectly fine when .docm is opened and autosaved as .docx—the header rows are retained and behave as expected.

However, once the .docx file is closed and reopened, all the header rows derived from <HDR> tags revert to normal rows and lose their header formatting. With your expertise, could you please advise if there’s a way to make these header rows persist when docx file is closed and reopened?

I would appreciate any guidance.

Thanks!

Here is the sub:
Code:
Private Sub AddHeaderRows_Tables()
    Dim table_instance As Table
    Dim cell_instance As Cell
    Dim txt As String
    Dim updated_txt As String
    Dim max_header_row As Long
    Dim target_row_index_for_header As Long
    Dim start_position As Long
    Dim end_position As Long
    Dim rng As Range

    If ActiveDocument.Tables.Count = 0 Then Exit Sub

    For Each table_instance In ActiveDocument.Tables

        ' find the last row in cell (x,1) that has tag + remove it
        max_header_row = 0 'for farthest tag entry in rows

        For Each cell_instance In table_instance.Range.Cells 'scanning all cells, but action on 1st col
            If cell_instance.ColumnIndex = 1 Then

                txt = cell_instance.Range.Text
                If Len(txt) >= 2 Then txt = Left$(txt, Len(txt) - 2)  ' delete end-of-cell ms-word markers

                If InStr(1, txt, "<HDR>", vbTextCompare) > 0 Then
                    updated_txt = Replace$(txt, "<HDR>", "", , , vbTextCompare) 'if tag present, updated text will not hv it

                    cell_instance.Range.Text = updated_txt & Chr(13) & Chr(7) ' append end-of-cell ms-word markers

                    If cell_instance.RowIndex > max_header_row Then
                        max_header_row = cell_instance.RowIndex ' this will reset row index from 0 to RowIndex, and will increase till last tag
                    End If
                End If
            End If
        Next cell_instance

        ' target_row_index_for_header holds rowIndex till where rows will be converted as header rows
        If max_header_row > 0 Then
            target_row_index_for_header = max_header_row
        Else
            target_row_index_for_header = 1  'in case if no tag found, atleast mark row no. 1 to be made header
        End If

        ' Setting range >> 1..target_row_index_for_header
        start_position = table_instance.Cell(1, 1).Range.Start
        end_position = start_position
        For Each cell_instance In table_instance.Range.Cells
            If cell_instance.RowIndex <= target_row_index_for_header Then
                If cell_instance.Range.End > end_position Then
                    end_position = cell_instance.Range.End 'setting end position to row will farthest tag entry
                End If
            End If
        Next cell_instance


        Set rng = ActiveDocument.Range(Start:=start_position, End:=end_position)

     '   table_instance.Cell(1, 1).Range.Select
      '  table_instance.ApplyStyleHeadingRows = False


        ' applying header format
        On Error Resume Next

        ' rng.Rows.HeadingFormat = wdToggle
        rng.Rows.HeadingFormat = True


        rng.Font.Bold = True
        rng.ParagraphFormat.Alignment = wdAlignParagraphCenter

        On Error GoTo 0



    Next table_instance

End Sub
Reply With Quote