Статьи из блога

Статьи из блога

Таблицы: Добавление колонок слева и справа в таблицы со слитыми ячейками

Рубрика: Макросы, Таблицы Word
Метки: |
Четверг, 14 апреля 2011 г.
Просмотров: 10245
Подписаться на комментарии по RSS
Версия для печати

[Ссылки на статью]

VBA-addict, активный участник нашего форума, предложил свое решение по таблицам. Публикую это решение также и здесь. Вопросы можете задавать автору заметки как в комментариях, так и на форуме.

 

При попытке добавления в таблицу со слитыми ячейками колонок слева и справа часто возникают проблемы связанные с тем, что ячейкам колонки присваивается ширина соседних ячеек. Соответственно, если ширина у них разная - таблица разлетается в столбчатую диаграмму.

 

Не найдя полностью готового решения в сети скомпилировал свое. Работает на текущей таблице под курсором.

 

Для добавления слева и справа код несколько отличается, т.к. при добавлении слева всегда ссылка идет на первую ячейку строки, которая есть всегда, а справа - на последнюю, номер которой может отличаться из-за слитых ячеек.

Sub AddCol2LeftMergedCTable()
    If Selection.Range.Information(wdWithInTable) = False Then Exit Sub
    With Selection.Tables(1)
        TblRowsNumber = .Rows.Count        
        NewColumnWidth = InputBox$("Enter the width in millimeters for the Column to add", _
                                   "Add column to the LEFT for a table with merged cells", _
                                   NewColumnWidth)
        If Val(NewColumnWidth) = 0 Then Exit Sub
        For i = 1 To TblRowsNumber
            .Range.Cells.Add BeforeCell:=.Cell(i, 1)
            .Cell(i, 1).Width = MillimetersToPoints(NewColumnWidth)
        Next
    End With
    Selection.MoveDown
End Sub
Sub AddCol2RightMergedCTable()
    If Selection.Range.Information(wdWithInTable) = False Then Exit Sub
    With Selection.Tables(1)
        TblRowsNumber = .Rows.Count
        NewColumnWidth = InputBox$("Enter the Width in millimeters" & vbCrLf & "for the Column to add", _
                                   "Add column to the RIGHT for a table with merged cells", _
                                   NewColumnWidth)
        If Val(NewColumnWidth) = 0 Then Exit Sub        
        For i = 1 To TblRowsNumber
            LastColNum = .Rows(i).Cells.Count
            .Rows(i).Cells(LastColNum).Select
            Selection.MoveRight
            Selection.InsertCells ShiftCells:=wdInsertCellsShiftRight 'добавляем ячейку'
            Selection.Cells.Width = NewColumnWidth
        Next
    End With
    Selection.MoveDown
End Sub
twitter.com facebook.com vkontakte.ru odnoklassniki.ru mail.ru ya.ru rutvit.ru myspace.com technorati.com digg.com friendfeed.com pikabu.ru blogger.com liveinternet.ru livejournal.ru memori.ru google.com bobrdobr.ru mister-wong.ru yahoo.com yandex.ru del.icio.us

Еще записи по вопросам использования Microsoft Word:

Комментариев: 1

  1. ovr36@mail
    07.12.2013 в 14:22 | #1

    Я - Чайник (с большой буквы), извините великодушно. В программах - ни бельмеса не соображаю. Но, может быть, Вы найдёте время кое-что сказать мне по моему делу? Нельзя ли, как программируемых микрокалькуляторах, создать и здесь программу для расчёта по формулам - ну, скажем для начала, площади окружности: S = pi*R*R? А уж впоследствии - использовать целый набор взаимосвязанных формул (микрокалькулятор имеет ограниченную память, а здесь можно писать почти до бесконечности). Осваивать современную программу на незнакомом языке, мне кажется, сложнее, чем использовать уже наработанный опыт для написания программ, не слишком заумных, но вполне пригодных для расчёта математических и инженерных задач. Или, по Вашему мнению, практичнее научиться программировать на простейшем языке (которым Вы считаете - какой?)?

Оставьте комментарий!

(обязательно)

^ Наверх