Добавить столбец в таблицу на VBA

[Serge_Bliznykov]

Добрый день.

Подскажите, пожалуйста, как в коде VBA
в текущей таблице (в которой сейчас курсор находится):

1) изменить ширину 2-го столбца (скажем, задать фиксированную ширину 1.2 см)

2) добавить справа столбец. (пусть, для простоты шириной 1 см)
внимание. в таблице есть строки с объединёнными ячейками. Там добавляется куча ненужный ячеек.
Надо этого избежать. (или просто удалить "лишние" ячейки в этих строчках.) ??

Подскажите, киньте, пожалуйста, примеро кода VBA (можно примеры/кусочки...)

p.s. собственно проблемная таблица прилагается. Это именно в неё стоит задача добавить столбец...

[viter.alex]

По поводу ширины столбца, это просто.

Selection.Tables(1).Columns(2).Width=CentimetersToPoints(1,2)

А с добавлением, подумаю.

Вот и добавление. Чтобы не мучаться, добавляю по ячейке в каждую строку. Если в строке после добавления получается две ячейки, т.е. это строка с объединенными ячейками, то ячейки в этой строке объединяются.

Sub InsertCol()
  Dim RowsCnt&, oTbl As Table, oCell As Cell, oCellFirst As Cell
  Set oTbl = Selection.Tables(1)
  Set oCellFirst = oTbl.Cell(oTbl.Rows.Count, oTbl.Columns.Count)
  For RowsCnt = 1 To oTbl.Rows.Count
    Set oCell = oTbl.Rows(RowsCnt).Cells.Add
    oCell.Width = oCellFirst.Width
    If oTbl.Rows(RowsCnt).Cells.Count = 2 Then oTbl.Rows(RowsCnt).Cells.Merge
  Next
End Sub

[Serge_Bliznykov]

СПАСИБО! БОЛЬШОЕ!
будем тестировать!

По поводу ширины столбца, это просто.
Selection.Tables(1).Columns(2).Widt h=CentimetersToPoints(1,2)

а... не так всё просто... для моей таблицы (с объединённым ячейками) так просто не получается
Ошибка выдаётся...
Но ладно. направление задано. буду пытаться!
p.s. Если по поводу ширины есть дополнительные идеи/трюки — с удовольствием приму информацию!

[viter.alex]

Сообщение от Serge_Bliznykov

…p.s. Если по поводу ширины есть дополнительные идеи/трюки — с удовольствием приму информацию!

Перебирай ячейки нужного тебе столбца. Номер столбца будет постоянным, а строки меняться. Только поставь On Error Resume Next, чтобы избежать ошибок, когда наткнешься на объединенную строку.

[Sasha_Smirnov]

Уф! Вымучил... Начинаю понимать нелюбовь к таблицам Word секретарш и верстальщиков.

Sub ToBeSureInWidth() 'добавляет в таблицу колонку, шириной равную последней'
Dim LastColNum As Byte, ColWidth As Single, ColWidth2 As Single, i As Integer
Dim ColHeader As String

With ActiveDocument.Tables(1).Rows(1).Cells
ColWidth = .Item(.Count).Width 'ширина добавляемого "столбца" (ColWidth)'
.Item(.Count).Select
With Selection: ColHeader = Left(.Text, Len(.Text) - 2): .Collapse: End With
MsgBox ColHeader
End With

Do
    i = i + 1
    With ActiveDocument.Tables(1).Rows(i)
        LastColNum = .Cells.Count
        .Cells(LastColNum).Select
    End With
                
    With Selection
        ColWidth2 = .Cells.Width 'ширина "столбца" перед добавляемым'
        .MoveRight
        .InsertCells ShiftCells:=wdInsertCellsShiftRight 'добавляем ячейку'
        .Cells.Width = ColWidth
        If i = 1 Then Selection.TypeText ColHeader 'заголовок нового столбца'
                If ColWidth2 > ColWidth + 5 Then '+ 5 точек - для надёжности'
                .MoveLeft Count:=2, Extend:=wdExtend
                .Cells.Merge 'объединяем 2 ячейки, если ширина 1-й > ColWidth'
                End If
    End With
            
Loop Until ActiveDocument.Tables(1).Rows(i).IsLast

End Sub

Сергей, обратная операция — или по Ctrl-Z (кстати, очень красиво!), или нужен новый макрос.
Макрос запускается кнопкой TG (гл. меню→Надстройки), а если кнопки не видно, используйте альт-G.

[Serge_Bliznykov]

viter.alex и Sasha_Smirnov!
Большое спасибо за помощь!!

Пришлось, правда, напильничком код довести до рабочего состояния.
Но, главное, результат достигнут.

p.s. а для изменения ширины столбцов с объединёнными ячейками сработал такой код:

On Error Resume Next

i = 0
Do
    i = i + 1    
    With oTbl.Rows(i)
        i1 = .Cells(1).Width
        i3 = 0
        If i1 < 420 Then
          i3 = .Cells(3).Width
          .Cells(1).Width = 78
          .Cells(2).Width = 34
          If i3 < 330 Then
            .Cells(3).Width = 240
            .Cells(4).Width = 45
            .Cells(5).Width = 46
            .Cells(6).Width = 46
          Else
            .Cells(3).Width = 377
          End If
        Else
          .Cells(1).Width = 489
        End If
    End With         
Loop Until oTbl.Rows(i).IsLast

[viter.alex]

А зачем сравнивать с конкретными числами ширину ячеек?

Объединенная ячейка по ширине равна ширине таблицы.

[Serge_Bliznykov]

Объединенная ячейка по ширине равна ширине таблицы.

нет. это не так. не забывайте, что объединёнными могут быть не все ячейки в строке. И тут в моём случае (правда в пример это, к сожалению, не попало) третья ячейка объединяет в себе все ячейки до конца строки...
поэтому её ширина = ширина таблицы - ширина_1-го столбца - ширина_2-го_столбца...

p.s. впрочем. это всё уже имеет только теоретическое значение - ибо практическая задача уже успешно решена...