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

25.08.2010, 22:37. **Показов** 41464. **Ответов** 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

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

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

Решение