Vba скопировать строку word

I am trying to duplicate a table row in Word, using VBA, without using the Selection object or the clipboard. That is, I want a new row that has the same content as an existing row.

To do this, I first create a new (empty) row, and loop through each cell in the source row and copy its contents into the corresponding cell in the target row.

To copy each cell, I get a Range object that references the entire content of the source cell, and an equivalent Range for the target cell, and then do this:

oToRange.FormattedText = oFromRange.FormattedText

This works well on Office 2003, and also works most of the time on Office 2010. However, I am having a real problem with one particular scenario. I have (greatly) simplified that scenario to demonstrate the core of the problem.

In the picture below, there are two cells in the outer (grey) 2R x 1C table. The second row is the row to be copied. The first row is the new row I created, and into which I want to copy the content of the second row.

enter image description here

You’ll notice that the second row contains a nested table.

When I run the code below in Word 2003, it works perfectly, and I get the following result:

enter image description here

But, in Word 2010, the same code produces this result:

enter image description here

As you can see, the cell content has been inserted before (and outside) the target table cell.

It’s worth mentioning that if I put something after the nested table, so that it’s no longer the last thing in the source cell, then this problem does not occur.

Here’s the full VBA code I’m using:

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

NOTE: the adjustment to the end of the source and target ranges is necessary because Cell.Range includes the end-of-cell marker, and I don’t want to copy that.

What can I do to persuade it to put the content inside the target cell (like Word 2003 does), rather than before it?

0 / 0 / 0

Регистрация: 13.11.2010

Сообщений: 19

1

08.03.2012, 00:26. Показов 10695. Ответов 5


Студворк — интернет-сервис помощи студентам

Доброй ночи всем.
В прикрепленном документе информация о фильмах, мне нужно посмотреть всех актеров, которые играют в фильмах, перечисленных в документе, сидеть и перебирать 133 фильма думаю не рационально. Нельзя ли на VBA написать модуль копирования определенной строки? То есть со всех ячеек (информация о фильмах дана в виде таблицы) нужно скопировать строку «В главных ролях:…» и вставить в новый документ.



0



Sasha_Smirnov

5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

08.03.2012, 08:42

2

Строки являются полями типа LINK, ссылающимися на закладки в таблице.

Сам программировал часа два, что, конечно, дольше, чем 135 вырезаний по Ctrl-F3 и одна вставка по Ctrl-Shift-F3. Так что даю вам готовенькое, а сам метод просто немного проиллюстрировал, поскольку работа с полями тема другая.

В приложенном архиве файл

список фильмов.doc, можете попереключать там (по Alt-F9) вид поля/значения.

Для установки закладок использован нижеследующий макрос.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Макрос1()
Dim i As Integer
    Selection.HomeKey unit:=wdStory 'встали на начало документа
    
    With Selection.Find
            .Text = "(^13)(В*ролях*)(^13Оператор)"
            .Replacement.Text = "1[2]3" 'взяли в [] абзац(ы) "В... ролях..."
            .Forward = True
            .MatchWildcards = True  'Подстановочные знаки (в окне по CTRL-h)
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
            
    Selection.HomeKey unit:=wdStory 'вернулись в начало документа
            .Replacement.Text = ""  'очистили поле "Заменить на:"
            
        Do
            .Text = "[*]"
            .Wrap = wdFindStop
            .Execute                'выделили очередную порцию текста, которая в []
            i = i + 1
            ActiveDocument.Bookmarks.Add Name:="Actors_" & Format(i, "000")
                                    'поставили закладку на актёров i-го фильма
        Loop Until Not .Found
        
            .MatchWildcards = False 'Подстановочные знаки отменили
    End With
End Sub

Миниатюры

Копирование строк в MS Word
 

Копирование строк в MS Word
 

Копирование строк в MS Word

Копирование строк в MS Word

Вложения

Тип файла: rar Архив.rar (61.9 Кб, 44 просмотров)



1



0 / 0 / 0

Регистрация: 13.11.2010

Сообщений: 19

08.03.2012, 11:20

 [ТС]

3

Спасибо большое, Александр.



0



Sasha_Smirnov

5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

10.03.2012, 08:15

4

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

Для одноразового транспонирования использовался следующий код.

Visual Basic
1
2
3
Sub Transposing()
Range("b2").PasteSpecial Transpose:=True 'b3, b4, b5, b6 и т. д.
End Sub

(Объединение всех моих дёрганий в единый программный концепт мне пока не по силам.)

Миниатюры

Копирование строк в MS Word
 



0



Sasha_Smirnov

5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

11.03.2012, 00:06

5

Лучший ответ Сообщение было отмечено Sasha_Smirnov как решение

Решение

Сначала преобразовал в текст (1), затем подчистил — и обратно преобразовал в таблицу (2).

В Word 97, 2000, 2003 инструменты на виду, в 2007 же и не пытался искать — шуршал макросами:

(1)

Visual Basic
1
2
3
4
5
6
7
8
Sub Макрос4()
'Нет, я не знаю, что все параметры значат; numcolumns:=13, numrows:=1 - очевидные
' Макрос4 Макрос
'
    WordBasic.TextToTable ConvertFrom:=0, numcolumns:=13, numrows:=1, _
        InitialColWidth:=wdAutoPosition, Format:=0, Apply:=1184, AutoFit:=0, _
        SetDefault:=0, Word8:=0, Style:="Сетка таблицы"
End Sub

(2)

Visual Basic
1
2
3
Sub toText()
Selection.Tables.Item(1).ConvertToText Separator:=wdSeparateByParagraphs ', nestedtables:=False
End Sub

Миниатюры

Копирование строк в MS Word
 

Вложения

Тип файла: rar список_фильмов.rar (36.8 Кб, 25 просмотров)



0



5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

11.03.2012, 00:47

6

Цитата
Сообщение от Sasha_Smirnov
Посмотреть сообщение

Сначала преобразовал в текст (1), затем подчистил — и обратно преобразовал в таблицу (2).

Перепутал макросы (1) и (2)!



0



In the below code:
mWrdTbl is an object containing the table of the 1st word document
adWrdTbl is an object containing the table of the 2nd word document
(both documents are opened)

mWrdTbl.Rows(R).Range.Copy
adWrdTbl.Range.PasteAppendTable

The code works but the row is pasted at the top of the table (I need it at the end)

Edit:

I found a workaround (but I’m not satisfied):

mWrdTbl.Rows(R).Range.Copy
adWrdTbl.Rows.Add
adWrdTbl.Rows.Add
adWrdTbl.Rows(adWrdTbl.Rows.Count - 1).Range.PasteAppendTable
adWrdTbl.Rows(adWrdTbl.Rows.Count).Delete
adWrdTbl.Rows(adWrdTbl.Rows.Count).Delete

asked Sep 9, 2021 at 14:06

genespos's user avatar

genesposgenespos

3,1915 gold badges38 silver badges69 bronze badges

This works for me

Dim myRange As Word.Range
Set myRange = adWrdTbl.Range
myRange.Collapse direction:=wdCollapseEnd
myRange.FormattedText = mWrdTbl.Range.Rows(R).Range.FormattedText

answered Sep 9, 2021 at 15:02

freeflow's user avatar

freeflowfreeflow

4,0933 gold badges10 silver badges17 bronze badges

6

Sub Макрос()

    Dim табл As Table, rng As Range

            ‘1. Присваиваем имя «табл» выделенной таблице или таблице, в которой находится курсор.
    Set табл = Selection.Tables(1)

        ‘2. Вставка разрыва страницы после таблицы.
    ‘1) Устанавливаем невидимый курсор после таблицы.
    Set rng = табл.Range
    rng.Collapse Direction:=wdCollapseEnd
    ‘2) Вставка разрыва.
    rng.InsertBreak Type:=wdPageBreak

        ‘3. Копируем в буфер обмена строки 1 — 7.
    табл.Rows(1).Select
    Selection.MoveDown Unit:=wdLine, Count:=6, Extend:=True
    Selection.Copy

        ‘4. Вставляем скопированное в начало следующей страницы.
    rng.Paste

        ‘5. Присваиваем имя вставленной таблице.
    Set табл = rng.Tables(1)

        ‘6. Очистка в таблице столбца 2.
    табл.Columns(2).Select
    Selection.Delete

    End Sub

[свернуть]


Word VBA. Копировать строку без использования Clipboard

От:

Enforcer

 
Дата:  27.12.07 11:41
Оценка:

Доброго времени суток!
Пытаюсь написать собственный примитивный серверный генератор doc файлов по шаблонам. Генератор берет на вход шаблон, в котором отмечены места вставки полей из БД, а также отмечены строки таблицы, которые нужно размножить по количеству строчек таблицы БД со вставкой туда данных полей.
Основная загвоздка — как размножить строки некоей таблицы с сохранением форматирования, объединения ячеек и т.д.
Единственный способ который я нашел:

SomeRange.Rows.Select
Selection.Copy
Selection.Paste

Но этот способ использует буфер обмена (clipboard), который один на пользователя, генератор отчетов будет жить на сервере, обрабатывать параллельно сразу несколько запросов, поэтому всегда есть риск что между Copy и Paste какой-то другой процесс сумеет втиснуться и испортить буфер обмена. Фактически я этого добился, запустив 2 экземпляра приложения с пошаговой отладкой.

Метод Range.InsertAfter/InsertBefore не подходит, т.к. он принимает string, а не Range.
Конструкция вроде AnotherRange.InsertBefore(SomeRange.Text) приводит к тому что в одну ячейку таблицы пихается содержимое копируемой строчки с разделителями-новая строка заместо вставки новой строчки.

Может кто пытался реализовать схожую задачу, ну или просто смог продублировать содержимое некоторых строчек таблицы word один в один без использования буфера обмена?


Re: Word VBA. Копировать строку без использования Clipboard

От:

ZAMUNDA

Земля

для жалоб и предложений
Дата:  27.12.07 13:37
Оценка:

Здравствуйте, Enforcer, Вы писали:

E>Доброго времени суток!


E>Метод Range.InsertAfter/InsertBefore не подходит, т.к. он принимает string, а не Range.

А почему тебе именно Range надо? У Range есть ещё Text, при этом, если использовать его то всё форматирование конечного Range сохраняется, т.е. ты просто на всех закладках в шаблоне форматирование нужное сделал, а потом переписываешь в них текст — я, в своём генераторе анкет так делал.
Правда у тебя там надо таблицы заполнять, ну тогда используй пользовательские стили, у того же Range есть свойство Style.

    ' Макрос в Application.Documents(2), т.е. ThisDocument есть Application.Documents(2).
    ' В обоих книгах я по закладке "test_bm" сделал.

    With ThisDocument.Bookmarks("test_bm").Range
        .Style = Application.Documents(1).Bookmarks("test_bm").Range.Style
        .Text = Application.Documents(1).Bookmarks("test_bm").Range.Text
    End With

Если открыты обе книги, то стили видны в обоих, после выполнения присваивания .Style, стиль из документа-шаблона скопируется в новый.

Наука изощряет ум; ученье вострит память.
(c) Козьма Прутков


Re[2]: Word VBA. Копировать строку без использования Clipboa

От:

Enforcer

 
Дата:  27.12.07 14:05
Оценка:

ZAM>Правда у тебя там надо таблицы заполнять, ну тогда используй пользовательские стили, у того же Range есть свойство Style.
У таблиц есть еще такая неприятная особенность, как свободный стиль рисования, когда ячейки произвольно объединяются вертикально и горизонтально со своей высотой и шириной. Просто скопировать стиль не получится.
Я пробовал прочитать разметку таблицы неким образом но каждый раз натыкался на засаду.
Если пробовать пройтись с использованием
1. foreach Row in Table.Rows (Col in Table.Columns)
выбрасывается исключение с текстом что то вроде «таблица не uniformed, по отдельным строчкам, столбцам ходить нельзя».
2. foreach Cell in Table.Cells такого не существует в природе, есть только Table.Cell(RowNum, CellNum),
3. а когда пытаешься пройтись
for row = 1 to Table.Rows.Count
for col = 1 to Table.Columns.Count
cell = Table.Cell(col, row)
next col
next row
для ячеек, которые объединены кидается исключение.

Можно конечно попробовать навернуть мегааналитический код, который запоминает структуру таблицы по тому кинулось ли исключение или нет, потом определить в каких ячейках какой текст сидит, потом всю эту мегаконструкцию воспроизводить самому, но мне казалось что гораздо более простой способ — скопировать все содержимое строки таблицы как есть и не заморачиваться с сохранением стилей, layout-ом таблицы и т.д.
При том что через Copy/Paste это делается на ура и как я писал единственный недостаток — использование clipboard-а.

Лирическое отступление:
Вообще я раньше довольно плотно работал с Excel VBA и там особо проблем не возникало. К слову там был нормальный метод что-то вроде
Range.InsertAfter(r as Range) т.е. можно было копировать любые области без использования clipboard.
Сейчас чем больше я пытаюсь испробовать подходов к решению элементарной задачи — наполнить word документ табличными данными с сохранением форматирования, заданного в dot шаблоне — тем больше меня разочаровывает объектная модель ворда. Уже 12 поколение, а возможности так и застряли где-то на 5-6.


Re: Word VBA. Копировать строку без использования Clipboard

От:

PA

 
Дата:  27.12.07 22:39
Оценка:

2 (1)

Здравствуйте, Enforcer, Вы писали:

E>Может кто пытался реализовать схожую задачу, ну или просто смог продублировать содержимое некоторых строчек таблицы word один в один без использования буфера обмена?

Вот примерчик, показывающий как копировать строки и как работать со строками, содержащими объединённые ячейки:

Function getLastCellOfRow(CurrentCell As Cell) As Cell
    Dim lastCell As Cell
    
    Set lastCell = CurrentCell
    Do
        If lastCell.Next Is Nothing Then Exit Do
        If lastCell.RowIndex < lastCell.Next.RowIndex Then Exit Do
        Set lastCell = lastCell.Next
    Loop
    
    Set getLastCellOfRow = lastCell
End Function

Sub Test()
    Dim doc As Document
    Dim tbl As Table
    Dim firstRowRange As Range
    Dim i As Integer
    Dim firstCell As Cell, lastCell As Cell
    
    Set doc = ActiveDocument
    Set tbl = doc.Tables(1)
    
    Set firstCell = tbl.Cell(1, 1) 'первая ячейка первой строки
    Set lastCell = getLastCellOfRow(firstCell) 'последняя ячейка первой строки
    
    doc.Range(firstCell.Range.Start, lastCell.Range.End).Rows.Select 'выделяем первую строку
    Set firstRowRange = Selection.FormattedText 'запомним содержимое первой строки
    
    i = tbl.Rows.Count 'номер последней строки
    Set firstCell = tbl.Cell(i, 1) 'первая ячейка последней строки
    Set lastCell = getLastCellOfRow(firstCell) 'последняя ячейка последней строки
    doc.Range(firstCell.Range.Start, lastCell.Range.End).FormattedText = firstRowRange 'вставляем копию первой строки
End Sub


Re[3]: Word VBA. Копировать строку без использования Clipboa

От:

ZAMUNDA

Земля

для жалоб и предложений
Дата:  28.12.07 08:58
Оценка:

Здравствуйте, Enforcer, Вы писали:

ZAM>>Правда у тебя там надо таблицы заполнять, ну тогда используй пользовательские стили, у того же Range есть свойство Style.

E>У таблиц есть еще такая неприятная особенность, как свободный стиль рисования, когда ячейки произвольно объединяются вертикально и горизонтально со своей высотой и шириной. Просто скопировать стиль не получится.
Так ты используй таблицы без объединения ячеек. Заполни данными, а потом сделай объединения необходимые и прочие косметические махинации. Самый простой алгоритм в таком случае, это объединять смежные ячейки с одинаковыми данными в них.

E>Сейчас чем больше я пытаюсь испробовать подходов к решению элементарной задачи — наполнить word документ табличными данными с сохранением форматирования, заданного в dot шаблоне — тем больше меня разочаровывает объектная модель ворда. Уже 12 поколение, а возможности так и застряли где-то на 5-6.

Да увы и ах… но Word заточен не на работу с таблицами а на вёрстку документов. Поэтому работа с таблицами, а тем более, её автоматизация там сделаны «постольку-поскольку».

Наука изощряет ум; ученье вострит память.
(c) Козьма Прутков


Re[2]: Word VBA. Копировать строку без использования Clipboa

От:

Enforcer

 
Дата:  28.12.07 13:42
Оценка:

PA>Вот примерчик, показывающий как копировать строки и как работать со строками, содержащими объединённые ячейки:
Оно!
Спасибо огромное!

Если кому интересно как выглядит моя конкретная имплементация на C# с использованием word interop — стучитесь в аську 117446559, покажу

Подождите ...

Wait...

  • Переместить
  • Удалить
  • Выделить ветку

Пока на собственное сообщение не было ответов, его можно удалить.

Like this post? Please share to your friends:
  • Vba элементы для excel
  • Vba экспортировать в excel
  • Vba чтение таблицы word
  • Vba числовой формат ячейки в excel на числовой
  • Vba цикл по ячейка в excel