Форум по VBA и MS Office

Sub A1_vedom()

' изменяем ориентацию страницы на альбомную
ActiveDocument.Sections(1).PageSetup.Orientation = _
wdOrientLandscape


'рисуем сетку таблицы
ActiveDocument.Tables(1).Borders.Enable = True

' Делаем таблицу по ширине окна, чтобы при изменении ширины столбцов, ширина таблицы
            ' оставалась исходной.
    ActiveDocument.Tables(1).AutoFitBehavior wdAutoFitWindow



'удаляем столбецы 2,3,8
  ActiveDocument.Tables(1).Cell(2, 2).Select
  Selection.SelectColumn
Selection.Columns.Delete

ActiveDocument.Tables(1).Cell(3, 2).Select
  Selection.SelectColumn
Selection.Columns.Delete

  ActiveDocument.Tables(1).Cell(8, 8).Select
  Selection.SelectColumn
Selection.Columns.Delete
     
 
  ' объединяем ячеки с пропуском объединенных

Dim Таблица As Table
    Dim i As Long
With ActiveDocument
    For Each myTable In .Tables
        On Error Resume Next
      Application.ScreenUpdating = False
    For Each Таблица In ActiveDocument.Tables
        For i = 1 To Таблица.Rows.Count
            Таблица.Cell(i, 10).Merge MergeTo:=Таблица.Cell(i, 11)
        Next i
    Next Таблица
    Application.ScreenUpdating = True
    Next myTable
End With


' задаем нужную ширину столбцов (не должно быть объединенных ячеек, иначе не работает)

With Selection.Tables(1)
    .PreferredWidthType = wdPreferredWidthPoints
    .Columns(1).PreferredWidth = CentimetersToPoints(0.9)
    .Columns(2).PreferredWidth = CentimetersToPoints(1.5)
    .Columns(3).PreferredWidth = CentimetersToPoints(6)
    .Columns(4).PreferredWidth = CentimetersToPoints(2)
    .Columns(5).PreferredWidth = CentimetersToPoints(2)
    .Columns(6).PreferredWidth = CentimetersToPoints(3)
    .Columns(7).PreferredWidth = CentimetersToPoints(8)
    .Columns(8).PreferredWidth = CentimetersToPoints(1.5)
    .Columns(9).PreferredWidth = CentimetersToPoints(1.5)
    .Columns(10).PreferredWidth = CentimetersToPoints(2)
End With

' устанавливает высоту строк в таблице

ActiveDocument.Tables(1).Rows.Height = 15

 
   
End Sub