Форматирование таблиц в документе (Microsoft Office Word)

Sub Макрос()
    Application.ScreenUpdating = False
    With ActiveDocument.Range.Font ' установка шрифта
        .Name = "Verdana"
        .Size = 8
    End With
    
  Dim S As Section, Header As HeaderFooter
    ' удаляем колонтитулы
    For Each S In ActiveDocument.Sections
        For Each Header In S.Headers
            Header.Range.Delete
        Next
        For Each Header In S.Footers
            Header.Range.Delete
        Next
    Next

  Dim colCount&, rowCount&, Center&, i&, j&, y&
  Dim Col As Range, Table As Table, EmptyCell$
  
    EmptyCell = Chr(13) & Chr(7)
    On Error Resume Next
    For Each Table In ActiveDocument.Tables ' для всех таблиц
        With Table
            ' установка рамки
            .Borders(wdBorderHorizontal).LineStyle = wdLineStyleOutset
            .Borders(wdBorderVertical).LineStyle = wdLineStyleOutset
            .Borders.OutsideLineStyle = wdLineStyleOutset
                
            colCount = .Columns.Count   ' количество колонок
            rowCount = .Rows.Count      ' количество строк
            
            ' поиск строки после заголока
            For i = 2 To rowCount
                Err.Clear
                For j = 1 To colCount
                    y = .Cell(i, j).Range.Bold
                    If Err.Number Then Exit For
                Next
                If j > colCount Then Exit For
            Next
            
            ' установка выравнивания для заголовка
            For Center = 1 To i - 1
                For j = 1 To colCount
                    With .Cell(Center, j)
                        .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                        .VerticalAlignment = wdCellAlignVerticalCenter
                        If .Range.Text = EmptyCell Then .Range.Text = " "
                    End With
            Next j, Center
            
            ' поиск номера столбца "Единицы измерения"
            Set Col = .Range
            If Col.Find.Execute(FindText:="Единицы измерения", MatchWholeWord:=True) Then
                Center = Col.Cells(1).ColumnIndex
            Else
                Center = 0
            End If
            Err.Clear
            
            ' обход строк таблицы после заголовка
            For i = i To rowCount
                y = .Cell(i, 2).Range.Bold
                If Err.Number = 0 Then
                    With .Cell(i, 1)
                        .Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
                        .VerticalAlignment = wdCellAlignVerticalCenter
                        If .Range.Text = EmptyCell Then .Range.Text = " "
                    End With
                    ' для всех ячеек строки i
                    For j = 2 To colCount
                        With .Cell(i, j)
                            If j = Center Then
                                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                                .VerticalAlignment = wdCellAlignVerticalBottom
                            Else
                                .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
                                .VerticalAlignment = wdCellAlignVerticalBottom
                            End If
                            If .Range.Text = EmptyCell Then .Range.Text = " "
                        End With
                    Next
                Else
                    With .Cell(i, 1)
                        .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                        .VerticalAlignment = wdCellAlignVerticalCenter
                        If .Range.Text = EmptyCell Then .Range.Text = " "
                    End With
                    Err.Clear
                End If
            Next
        End With
    Next
    Set Col = Nothing
    Application.ScreenUpdating = True
End Sub