1 Тема от jaroslav

  • jaroslav
  • сержант
  • Неактивен
  • Зарегистрирован: 07.05.2010
  • Сообщений: 29

Тема: вставка столбца в таблицу с объединенными ячейками

Всем привет. Часто работаю с большими таблицами, в которых заголовки объединены. Мне нужно вставить столбец справа. Но после вставки столбца столбцы приобретают очень некрасивый вид. Для вставки столбца вырезаю заголовки с объединенными ячейками, вставляю столбец, потом копирую текст с объединенных ячеек и вставляю опять в таблицу, и снова объединяю ячейки. Подскажите, пожалуйста, можно ли как-то упростить вставку столбца справа в таблицу с объединенными ячейками.
Пример таблицы прилагаю

Post's attachments

Обсяги постачання_ПКТБ.doc 36 Кб, 7 скачиваний с 2014-05-06 

You don't have the permssions to download the attachments of this post.

2 Ответ от mikkelle

  • mikkelle
  • полковник
  • Неактивен
  • Зарегистрирован: 21.01.2010
  • Сообщений: 227
  • Поблагодарили: 12

Re: вставка столбца в таблицу с объединенными ячейками

У вас какая версия ворда? В 2010 достаточно вставить столбец справа от выбранного, затем просто объединить ячейки строки заголовка.

3 Ответ от jaroslav

  • jaroslav
  • сержант
  • Неактивен
  • Зарегистрирован: 07.05.2010
  • Сообщений: 29

Re: вставка столбца в таблицу с объединенными ячейками

Вот ответ, который я нашел в интернете:

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
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