Содержание в виде таблице по ГОСТ

Sub MyContent()
  Dim oRng As Range
  Dim oTbl As Table
  Dim oCell As Cell

  'Добавляем содержание в документ
  With ActiveDocument
    .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
      True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
      LowerHeadingLevel:=4, IncludePageNumbers:=True, AddedStyles:="", _
      UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
      True
    .TablesOfContents(1).TabLeader = wdTabLeaderSpaces
    .TablesOfContents.Format = wdIndexIndent
    Set oRng = .TablesOfContents(.TablesOfContents.Count).Range
    'Разбиваем поле содержания
    oRng.Fields.Unlink
    'Преобразуем разбитое содержание в таблицу
    Set oTbl = oRng.ConvertToTable(vbTab)
  End With

  'Добавляем один столбец слева
  oTbl.Columns.Add oTbl.Columns(1)

  For Each oCell In oTbl.Columns(2).Cells
    Set oRng = ActiveDocument.Range(oCell.Range.Start, oCell.Range.End - 1)
    'Ссылка на номер
    oRng.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdNumberFullContext, ReferenceItem:=oCell.RowIndex, InsertAsHyperlink:=True
    oCell.Range.InsertAfter "." & Chr(160)
    'Ссылка на текст
    Set oRng = ActiveDocument.Range(oCell.Next.Range.Start, oCell.Next.Range.End - 1)
    oRng.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdContentText, ReferenceItem:=oCell.RowIndex, InsertAsHyperlink:=True
    'Ссылка на номер страницы
    Set oRng = ActiveDocument.Range(oCell.Next.Next.Range.Start, oCell.Next.Next.Range.End - 1)
    oRng.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=oCell.RowIndex, InsertAsHyperlink:=True
    oCell.Merge oCell.Next
    'Удаляем абзаца, которые появляются после объединения ячеек
    oCell.Range.Find.Execute FindText:="^p", ReplaceWith:="", Replace:=wdReplaceAll
    DoEvents
  Next
  'Форматирование таблицы
  With oTbl
    .Rows.SetLeftIndent LeftIndent:=-21.6, RulerStyle:=wdAdjustNone
    .PreferredWidth = CentimetersToPoints(18.5)
    .AllowPageBreaks = True
    .AllowAutoFit = False
    'Устанваливаем отсутп от края (вровень с рамочкой) и размеры колонок
    .Columns(1).PreferredWidthType = wdPreferredWidthPoints
    .Columns(1).PreferredWidth = CentimetersToPoints(6)
    .Columns(2).PreferredWidthType = wdPreferredWidthPoints
    .Columns(2).PreferredWidth = CentimetersToPoints(9.5)
    .Columns(3).PreferredWidthType = wdPreferredWidthPoints
    .Columns(3).PreferredWidth = CentimetersToPoints(3)
    'заголовок таблицы
    .Cell(1, 1).Range.Text = "Обозначение"
    .Cell(1, 2).Range.Text = "Наименование"
    .Cell(1, 3).Range.Text = "Примечание"
    .Columns.Last.Select
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    With .Rows(1).Range
      .Font.Bold = True
      .Font.Size = 12
      .ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With
  End With
End Sub

Dim myHeadings
myHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
For i = LBound(myHeadings) To UBound(myHeadings)
        'во вторую колонку вносим номер заголовка
        oTable.Cell(i + 1, 2).Select
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdNumberFullContext, ReferenceItem:=i, InsertAsHyperlink:=True
        Selection.TypeText Text:=". "
        ' и название
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True
        ' ОПРЕДЕЛЯЕМ ДЛИНУ СТРОКИ ВО ВТОРОЙ ЯЧЕЙКЕ
        strCell = oTable.Cell(i + 1, 2).Range.Text
        strLen = Len(strCell)
        If strLen > 30 Then
            'MsgBox (strCell)
        End If
        
        'в третью колонку вносим номер страницы. Выравниваем по центру
        oTable.Cell(i + 1, 3).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=i, InsertAsHyperlink:=True
        
        'добавляем строку перед последней
        oTable.Rows.Add (oTable.Rows(oTable.Rows.Count))
Next