Как я могу дублировать строку в таблице Word?

Question

Как я могу дублировать строку в таблице Word?

Я пытаюсь скопировать строку таблицы в Word, используя VBA, без использования объекта выделения или буфера обмена. То есть я хочу новую строку, которая имеет то же содержание, что и существующая строка.

Для этого я сначала создаю новую (пустую) строку, перебираю каждую ячейку исходной строки и копирую ее содержимое в соответствующую ячейку целевой строки.

Чтобы скопировать каждую ячейку, Я получаю объект Range, который ссылается на все содержимое исходной ячейки, и эквивалент Range для целевой ячейки, а затем сделайте следующее:

oToRange.FormattedText = oFromRange.FormattedText

Это хорошо работает в Office 2003, а также работает большую часть времени в Office 2010. Однако у меня есть реальная проблема с одним конкретным сценарием. Я (значительно) упростил этот сценарий, чтобы продемонстрировать суть проблемы.

На рисунке ниже, есть две ячейки во внешней (серой) таблице 2R x 1C. Вторая строка-это строка, которую нужно скопировать. Первая строка-это новая строка, которую я создал и в которую я хочу скопировать содержание второго ряда.

Введите описание изображения здесь

Вы заметите, что вторая строка содержит вложенную таблицу.

Когда я запускаю приведенный ниже код в Word 2003, он отлично работает, и я получаю следующий результат:

Введите описание изображения здесь

Но в Word 2010 тот же код приводит к следующему результату:

Введите описание изображения здесь

Как вы можете видеть, содержимое ячейки было вставлено перед (и снаружи) целевой ячейки таблицы.

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

Вот полный код VBA, который я использую:

Dim oDoc As Word.Document

Set oDoc = ThisDocument



Dim oFromRange As Range

Set oFromRange = ThisDocument.Tables(1).Cell(2, 1).Range

oFromRange.End = oFromRange.End - 1



Dim oToRange As Range

Set oToRange = ThisDocument.Tables(1).Cell(1, 1).Range

oToRange.End = oToRange.End - 1



oToRange.FormattedText = oFromRange.FormattedText

Примечание: корректировка до конца исходного и целевого диапазонов необходима, потому что Cell.Range включает маркер конца ячейки, и я не хочу его копировать.

Что я могу сделать, чтобы убедить его поместить содержимое внутрь целевой ячейки (как это делает Word 2003), а не раньше это?

1092 2

vba office-interop ms-word word-vba office-2010

2 ответов:

Comments

Ничего не найдено.

Siddharth Rout · Accepted Answer · 2013-09-13 11:45:33

Надеюсь, я правильно понял ваш запрос... Разве это не то, что вы пытаетесь сделать? Этот код скопирует строку 1 таблицы и создаст копию этой строки под ней.
Sub Sample()
    Dim tbl As Table

    Set tbl = ActiveDocument.Tables(1)

    tbl.Rows(1).Range.Copy
    tbl.Rows(1).Select
    Selection.InsertRowsBelow
    tbl.Rows(2).Range.Paste
End Sub
Скриншот

Последующие действия (из комментариев)

Этот код не использует объект Selection
Sub Sample()
    Dim tbl As Table
    Dim rowNew As Row

    Set tbl = ActiveDocument.Tables(1)
    Set rowNew = tbl.Rows.Add(BeforeRow:=tbl.Rows(1))
    tbl.Rows(2).Range.Copy
    tbl.Rows(1).Range.Paste
End Sub
Дополнительные наблюдения (из комментариев)
Sub Sample()
    Dim tbl As Table
    Dim rowNew As Row

    Set tbl = ActiveDocument.Tables(1)
    Set rowNew = tbl.Rows.Add(BeforeRow:=tbl.Rows(1))
    tbl.Rows(1).Range.FormattedText = tbl.Rows(2).Range.FormattedText
    '~~~> This is required as the above code inserts a blank row in between
    tbl.Rows(2).Delete
End Sub

Shimon Doodkin · Accepted Answer · 2018-08-06 17:50:47

Function duplicate_row(ByRef ontable, rownnumber) As Row
 Dim c
 Dim fromrow As Row
 Dim newrow As Row
 Set fromrow = ontable.Rows(rownnumber)
 Set newrow = ontable.Rows.Add
 newrow.Range.FormattedText = fromrow.Range.FormattedText
 ontable.Rows(ontable.Rows.Count).Delete
 Set duplicate_row = newrow
End Function



Sub test()
 Dim newrow As Row

 Set newrow = duplicate_row(ActiveDocument.Tables(1), 2)
 newrow.Range.Find.Execute FindText:="text_service", ReplaceWith:="aaa", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_amount", ReplaceWith:="500", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_price", ReplaceWith:="50", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_comment", ReplaceWith:="bbb", Replace:=wdReplaceAll

' ActiveDocument.Tables(1).Rows(1).Delete ' after adding all rows, delete the tempalte row
End Sub