Макрос для переноса данных в виде таблицы из Excel в Word

25.08.2010, 22:37. **Показов** 41193. **Ответов** 17

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

Добрый день, помогите пожалуйста довести до ума макрос , который бы экспортировал определенные данные из таблицы в виде таблицы
Excel в Word. Критерием для выбора определенной строки из всего объема таблицы служит отмеченный напротив нужной строки флажок.
Как это приблизительно должно выглядеть показано в приложенной таблице.
Вот что удалось получить:

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
28
29
30
31
32
Sub button_click()
 
End Sub
Sub Makros1()
 
Dim AppWord As Word.Application
 
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True
 
AppWord.Documents.Add
 
Range("A5:G5").Copy
AppWord.Selection.Paste
 
For i = 6 To 10
 
If Cells(i, 18) = True Then
 
 
Cells(i, 1).Copy
AppWord.Selection.Paste
 
 
End If
 
Next
 
Application.CutCopyMode = False
Set AppWord = Nothing
 
End Sub

Единственное что, сейчас копируются выделенные ячейки только первого столбца, подскажите пожалуйста как можно расширить этот диапазон и как сделать так, чтобы заголовки таблицы и данные из таблицы брались не из всего диапазона таблицы, а выборочно (например ячейкa 3 столбца A, столбца C, диапазона E:G и т.д) и выводились в Word.
Буду очень признателен за любую помощь.

@Busine2009 · 28.08.2010, 06:24

E.v.g,
вот так копируется строка:

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
Sub Макрос1()
Dim AppWord As Word.Application
Dim i As Long
     
Set AppWord = CreateObject("Word.Application")
 
AppWord.Visible = True
AppWord.Documents.Add
 
Range("A5:G5").Copy
AppWord.Selection.Paste
 
For i = 6 To 10
    If Cells(i, 18) = True Then
        Range(Cells(i, 1), Cells(i, 16)).Copy
        AppWord.Selection.Paste
    End If
Next
 
Application.CutCopyMode = False
Set AppWord = Nothing
 
End Sub

28.08.2010, 12:26

Добрый день Busine2009, спасибо за ответ. В таком случае он копирует строку подряд,
подскажите пожалуйста как копировать строку выборочно, например области A6:B6, E6:G6, I6:L6 и так далее при тех же условиях.

@Tinoo · 20.06.2011, 15:05

Вот код, который увеличивает диапазон, по другому вопросу ответа не знаю.

Visual Basic
1
2
3
4
5
6
7
8
Sub main()
    Set wa = CreateObject("Word.Application")
    wa.Visible = True: Set wd = wa.Documents.Add
    wd.PageSetup.Orientation = 1
    [a1:l43].Copy
    wd.Range.PasteExcelTable False, False, False
    Application.CutCopyMode = False
End Sub

@Makarona · 26.08.2011, 16:35

Добрый день!
бьюсь над переносом данных из Excel в Word.
Задача: по вордовским закладкам засунуть в документ определённые таблицы.

на разных сайтах нашла варианты решений, понравился один, подогнала под себя а выдаёт ошибку. Вот кусок. Подсткажите, плиз, чтож я делаю неправильно

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 Dim strDoc As String
    
     
    Dim wdApp As Word.Application, wdDoc As Word.Document, objDoc As Word.Document
    Dim xlRange As Excel.Range
    Dim exlR As Excel.Range
        
    Set wdApp = New Word.Application
    FilePath = ActiveWorkbook.Path
    Filename = "C:\Documents and Settings\User\Desktop\Автоматизация.docx"
    
       Set objDoc = wdApp.Documents.Add(Template:=FilePath & "" & Filename)
     
     If objDoc Is Nothing Then
        MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
        wdApp.Quit
        Set appWrd = Nothing
        Exit Sub
    End If
  
 
 
  Set exlR = Лист6.Range("A2:B13")
 
 
     With objDoc.Bookmarks
        .Item("Первая_таблица").Range.InsertAfter exlR
     End With
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
 
    wdApp.Visible = True
    wdApp.ActiveDocument.SaveAs FilePath & "" & " Проба.docx"
     'Clean up
    Set wdApp = Nothing
    Set objDoc = Nothing
     
End Sub

Ругается на .Item("Первая_таблица").Range.InsertAfte r exlR пишет Type MisMatch

Заранее спасибо за помощь. Надеюсь подскажете, а то ручками вставлять и связывать таблиц 35 в каждый документ регулярно.... ну очень нудно и долго

@Busine2009 · 26.08.2011, 17:47

Makarona,
скопируйте нужный диапазон ячеек в Excel, а затем вставьте в документ Word.

@Makarona · 26.08.2011, 17:56

Busine2009,
Вы имеете ввиду следующее:

Visual Basic
1
2
3
4
5
6
exlR.Select
Selection.Copy
 
     With objDoc.Bookmarks
        .Item("Первая_таблица").Range.InsertAfter Selection
     End With

Я нечто подобное пробовала, но он опять выдаёт ту же ошибку на той же строке.
Или я неправильно Вас поняла?

@Busine2009 · 26.08.2011, 17:59

Здесь после Range поставьте точку и выберите что-нибудь связанное с Paste:

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

.Item("Первая_таблица").Range.InsertAfte r Selection

Здесь сразу можно копировать (выделять не надо перед копированием):

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

exlR.Select

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

@Makarona · 26.08.2011, 18:02

Busine2009,
подобное тоже пробовала...
говорит, что такой метод ему не знаком.
видимо, не всё с past перебрала...
но спасибо. Если Вы советуете тоже, что делала, значит капаю в нужном направлении...

@Busine2009 · 26.08.2011, 18:04

Код, на котором я тестировал:

Visual Basic
1
2
3
4
5
6
7
8
Sub Процедура1()
Dim Ворд As New Word.Application, Документ As Word.Document
Ворд.Visible = True
Set Документ = Ворд.Documents.Add
Документ.Bookmarks.Add Name:="Bookmark1", Range:=Документ.Range(0, 0)
Range("A1:B6").Copy
Документ.Bookmarks.Item("Bookmark1").Range.Paste
End Sub

@Makarona · 29.08.2011, 09:57

Busine2009,
спасибо!
теперь буду дописывать Ваш код под себя, чтоб таблицы были связаны, документ сам открывался.
зато Благодаря Вам у меня таблица вставляется, а не текст.

Добавлено через 14 минут
Хм, забавная вещь получается: кодом вставляется таблица, но она сама меняет место закладки.
т.е. получилось, что таблица попала в начало документа и говорит, что именно здесь была закладка 1

Хитрая, зараза))

Убрала строку
Документ.Bookmarks.Add Name:="Bookmark1", Range:=Документ.Range(0, 0)

и всё стало ок)

@Busine2009 · 29.08.2011, 10:07

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

Документ.Bookmarks.Add Name:="Bookmark1", Range:=Документ.Range(0, 0)

это ж вставка закладки в документ, а у вас уже все закладки вставлены.

@Makarona · 29.08.2011, 11:22

Busine2009, да, сначала вставила всё тупо, потом код прочитала. С утра туго соображаю...
Теперь код пишется как по маслу. Спасибо ещё раз за шаблон, очень помогло.

Добавлено через 1 час 11 минут
Очередной вопрос.
Как вставить эти таблицы связанными?
что-то никак сообразить не могу((
балда какая-то я сегодня...

@Busine2009 · 29.08.2011, 11:42

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

Как вставить эти таблицы связанными?

есть 2 варианта связанных таблиц:

в виде рисунка;
в виде таблицы.

Если вставить в виде рисунка, то таблица не будет переходить на следующую страницу, если она больше страницы.

@Makarona · 29.08.2011, 11:47

Busine2009,
мне всё в виде таблиц надо.

@Busine2009 · 29.08.2011, 12:31

Код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Макрос1()
Dim Ворд As Word.Application
Dim Документ As Word.Document
'Чтобы работать с запущенной программой Word,
'надо использовать GetObject.
Set Ворд = GetObject(Class:="Word.Application")
'Подключение к активному документу Word.
Set Документ = Ворд.ActiveDocument
'Копирование диапазона ячеек из активной книги, из активного листа Excel.
ActiveWorkbook.ActiveSheet.Range("A1:E5").Copy
'Вставка скопированного в закладку с именем Закладка1.
'LinkedToExcel:=True - при обновлении данных в Excel, данные будут обновлены в Word.
'WordFormatting:=True - шрифт текста вставленной таблицы будет в соответствии со
'стилем Сетка таблица, а не как в Excel.
'RTF:=True - таблица будет использовать RTF, а не HTML (этого сам не понимаю).
Документ.Bookmarks("Закладка1").Range.PasteExcelTable _
    LinkedToExcel:=True, WordFormatting:=True, RTF:=True
'Снятие пунктирной линии в Excel после копирования.
Application.CutCopyMode = False
End Sub

Если не знаете, что написать в коде, то используйте макрорекордер:

В вашем случае надо было записать макрос в Word:

скопируйте ячейки в Excel;
перейдите в Word;
включите макрорекордер;
Правка - Специальная вставка... - Связать - Текст в формате RTF - OK;
отключите макрорекордер;
перейдите в VBA;
поставьте курсор на слово PasteExcelTable и нажмите клавишу F1;
появится справка (правда на английском языке), по которой можно подкорректировать код.

@Makarona · 29.08.2011, 14:11

Вау!
немного переделала на то, чтоб открывался закрытый документ Word и формат Excel использовался. Всё, что нужно. Огромное спасибо за комментарии и описание. с Вами VBA выучу скоро.

а то программиста нашего не допросишься помочь. Легче самой написать...

Добавлено через 1 час 5 минут
Поняла смысл вот этой строки

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

'RTF:=True - таблица будет использовать RTF, а не HTML (этого сам не понимаю).

Если поставить False, то остаётся форматирование Excel (если ячейки объединены, например), а если True, то все объединения ячеек сбиваются и таблица плывёт (особенно заголовки)

@Makarona · 08.11.2011, 14:10

С таблицами более-менее понятно, а вот что делать с вставкой диаграмм так же из Excel в Word по закладкам? бъюсь над этим, но не могу поянть свою ошибку. Диаграмма вставляется, но в левыё верхний угол, а не по закладке. кусочек кода:

Visual Basic
1
2
3
4
5
6
7
8
Ëèñò1.ChartObjects("Ä_Ïðîäàæè1").Activate
           'активирую нужную диаграмму
  ActiveChart.ChartArea.Copy
           'копирую диаграмму
  Äîêóìåíò.Bookmarks.Item("Ä_Ïðîäàæè1").Select
           'выбираю нужную закладку в документе
  Âîðä.Selection.PasteSpecial Placement:=wdInLine
           'а тут вставляется диаграмма, но не на место закладки, а в начало документа

пробовала так:

Visual Basic
1
Âîðä.Selection.PasteAndFormat Placement:=wdInLine

не получилось

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

Добавлено через 2 часа 43 минуты
Вроде немного разобралась
пока нашла такое решение, но если кто-нибудь оптимизирует или подправит меня, буду благодарна.

Visual Basic
1
2
3
4
Ëèñò1.ChartObjects("Ä_Ïðîäàæè1").Activate
    ActiveChart.ChartArea.Copy
  Äîêóìåíò.Bookmarks.Item("Ä_Ïðîäàæè1").Select
Âîðä.Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine

Новые блоги и статьи Все статьи Все блоги /
WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Old Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .	Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114
Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и напряжениями. Надо найти токи в ветвях. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и решает её. Последовательность действий:. . .	Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .

E.v.g
	28.08.2010, 12:26
	Добрый день Busine2009, спасибо за ответ. В таком случае он копирует строку подряд, подскажите пожалуйста как копировать строку выборочно, например области A6:B6, E6:G6, I6:L6 и так далее при тех же условиях.

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	26.08.2011, 17:47
	Makarona, скопируйте нужный диапазон ячеек в Excel, а затем вставьте в документ Word. 0

@Makarona 1 / 1 / 0 Регистрация: 27.07.2011 Сообщений: 37
	26.08.2011, 18:02
	Busine2009, подобное тоже пробовала... говорит, что такой метод ему не знаком. видимо, не всё с past перебрала... но спасибо. Если Вы советуете тоже, что делала, значит капаю в нужном направлении... 0

@Makarona 1 / 1 / 0 Регистрация: 27.07.2011 Сообщений: 37
	29.08.2011, 09:57
	Busine2009, спасибо! теперь буду дописывать Ваш код под себя, чтоб таблицы были связаны, документ сам открывался. зато Благодаря Вам у меня таблица вставляется, а не текст. Добавлено через 14 минут Хм, забавная вещь получается: кодом вставляется таблица, но она сама меняет место закладки. т.е. получилось, что таблица попала в начало документа и говорит, что именно здесь была закладка 1 Хитрая, зараза)) Убрала строку Документ.Bookmarks.Add Name:="Bookmark1", Range:=Документ.Range(0, 0) и всё стало ок) 0

@Makarona 1 / 1 / 0 Регистрация: 27.07.2011 Сообщений: 37
	29.08.2011, 11:22
	Busine2009, да, сначала вставила всё тупо, потом код прочитала. С утра туго соображаю... Теперь код пишется как по маслу. Спасибо ещё раз за шаблон, очень помогло. Добавлено через 1 час 11 минут Очередной вопрос. Как вставить эти таблицы связанными? что-то никак сообразить не могу(( балда какая-то я сегодня... 0

@Makarona 1 / 1 / 0 Регистрация: 27.07.2011 Сообщений: 37
	29.08.2011, 11:47
	Busine2009, мне всё в виде таблиц надо. 0

Макрос для переноса данных в виде таблицы из Excel в Word

Решение