Встваить таблицы из Exccel в Word

@Tinoo · Регистрация: 09.03.2011

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

Пожалуйста подскажите, как можно из определенного листа Excel вставить таблицу в определенный документ в Word в определенное место (определенное место - после фиолетового заголовка). Заранее СПАсиБО ! Вот код, который просто копирует таблицу из Excel в Word.

Sub main()
Set wa = CreateObject("Word.Application")
wa.Visible = True: Set wd = wa.Documents.Add
' 2- меняет ориентацию страницы на альбомную
wd.PageSetup.Orientation = 0
[a4:h30].Copy
wd.Range.PasteExcelTable False, False, False
Application.CutCopyMode = False
End Sub

@Busine2009 · 29.06.2011, 13:06

Код:

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
42
43
44
45
46
47
48
49
50
51
52
Sub P1()
Dim Ворд As Object
Dim Документ As Object
'Диапазоны всех листов помещу в массив
'(это поименованное место в оперативной памяти компьютера,
'состаящее из одной или несколько переменных).
'У меня будет в книге 5 листов, соответственно 5 диапазонов.
'А в массиве будет 5 переменных.
Dim Массив(1 To 5) As String
Dim i As Integer
'В каждую переменную массива помещу диапазон. Диапазоны выдумаю.
Массив(1) = "A5:P10" 'Диапазон для первого листа.
Массив(2) = "B5:P10" 'Диапазон для второго листа.
Массив(3) = "C5:D12"
Массив(4) = "E12:F16"
Массив(5) = "E24:I29"
'Программа Word запущена и открыт интересующий нас документ Word.
'Если Word не запущен, то надо использовать CreateObject.
Set Ворд = GetObject(Class:="Word.Application")
'У меня находится документ на рабочем столе и ОТКРЫТ.
'Если документ не открыт, его сначала надо открыть с помощью Open.
Set Документ = Ворд.Documents("C:\Documents and Settings\Пользователь\Рабочий стол\Заголовки.docx")
'С помощью For ... To ... Next ... Step буду
'повторять одно и то же действие заданное количество раз (5 раз).
'Обрабатываю активную книгу.
For i = 1 To 5 Step 1
    'Копирование диапазона на очередном листе.
    ActiveWorkbook.Sheets(i).Range(Массив(i)).Copy
    'Заголовки в документе Word у меня имеют следующие название: Лист1, Лист2 и т.д.
    'Ищем в документе Word заголовок, текст которого совпадает с именем листа
    'Excel, из которого копируется диапазон.
    With Документ.Content.Find
        .Text = ActiveWorkbook.Sheets(i).Name
        .Format = True
        'Заголовок должен иметь стиль определённый.
        .Style = "Заголовок 1"
        .Execute
        'Если найдено, то
        If .Found = True Then
            'Parent - это диапазон документа, в котором находится
            'наш заголовок.
            'Вставляем после нашего заголовка пустой абзац.
            .Parent.Paragraphs(1).Range.InsertParagraphAfter
            'А в этот пустой абзац - скопированную из Excel таблицу.
            .Parent.Paragraphs(1).Next.Range.Paste
        End If
    End With
Next i
'Снимаем копирование в Excel (чтобы не было пунктирной линии).
Application.CutCopyMode = False
MsgBox "Работа сделана"
End Sub

@Tinoo · 29.06.2011, 13:50 **[ТС]**

Busine2009, ААааааааааааа ты ГЕНИЙ !!!!!!!! ))))))

Скажи, как можно тебя отблагодарить ?

19.06.2013, 13:30

Господа нужно экспортировать таблицу из экселя в ворд. Сделал такой код (см. ниже).
При работе получаются следуюшие "траблы":
1) если закрыть ворд, то при новом запуске выходит ошибка "что сервер не сущ. или не запущен" при выполнении команды

Visual Basic
1
With .... .PreferredWidth = CentimetersToPoints(17)

2) при выводе второй таблицы, добавил две задержки по 0,5с

Visual Basic
1
Sleep (500)

, без них. таблица разделяется криво , одна колонка широкая другая длинная. С задержками все хорошо.
Как это победить не знаю, может кто подскажет...

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
 
Sub P1()
'Для удобства написания кода подключим библиотеку объектов программы Word:
'Tools - References... - Microsoft Word Object Library.
'Удобство заключается в том, что когда будем ставить точку, то будет
'представлен список членов программы Word.
'Предполагается, что программа Word запущена, чтобы не создавать новый экземпляр
'и работать с активным документом.
Dim Ворд As Word.Application
Dim Документ As Word.Document
Dim Книга As Excel.Workbook
Dim Table1 As Word.Table
 
Set Книга = Excel.ActiveWorkbook
 
 
 
Set Ворд = CreateObject("Word.Application")
Ворд.Visible = True
Set Документ = Ворд.Documents.Add
 
With Документ
    .PageSetup.TopMargin = 25
    .PageSetup.LeftMargin = 70
    .Content.Font.Size = 14
End With
 
 
Книга.Worksheets("Сводник").Range("A6:E16").Copy
 
With Документ
    
    .Range.InsertParagraphAfter
    .Range(Start:=.Range.End - 1, End:=.Range.End - 1).PasteExcelTable _
        LinkedToExcel:=False, WordFormatting:=False, RTF:=True
      
'    .Tables(1).Rows(1).Delete ' удалем первую строку таблицы
        
    With .Tables(1)
        .Rows(1).Delete ' удалем первую строку таблицы
        .Cell(Row:=1, Column:=1).Merge _
            MergeTo:=.Cell(Row:=1, Column:=3) ' объединяет ячейки 1 и 2 1й строки
         '.Borders.Enable = False удаляет границы
        .PreferredWidth = CentimetersToPoints(17)
    End With
    '.Tables(1).PreferredWidth = CentimetersToPoints(17)
End With
 
'Снимаем выделение в Excel.
Application.CutCopyMode = False
 
 
Книга.Worksheets("Сводник").Range("A18:E56").Copy
 
With Документ
    .Range.InsertParagraphAfter
    .Range(Start:=.Range.End - 1, End:=.Range.End - 1).PasteExcelTable _
        LinkedToExcel:=False, WordFormatting:=False, RTF:=True
        .Tables(2).Rows(3).HeadingFormat = True
        Sleep (500)
        .Tables(2).Columns.PreferredWidth = CentimetersToPoints(4)
        Sleep (500)
        .Tables(2).Cell(2, 4).Split NumColumns:=2 ' разделям колонку
        .Tables(2).PreferredWidth = CentimetersToPoints(17.5) ' установливаем ширину табл.
End With
 
'Снимаем выделение в Excel.
Application.CutCopyMode = False
Set Ворд = Nothing
Set Документ = Nothing
Set Книга = Nothing
Set Table1 = Nothing
Exit Sub

Новые блоги и статьи Все статьи Все блоги /
FPS контроллер с анимированными Y-Bot и 3D-звуком miniaudio (Box3D, Recast, BehaviorTree.CPP, ozz-animation, ImGui, OpenGL и SDL3) 8Observer8 18.10.2026 Содержание блога \| English Version Полное мультиплатформенное руководство по стартовому проекту с FPS-контроллером игрока, анимированными роботами Y-Bot с 4-слойным блендингом, 3D-физикой Box3D,. . .	Локальный http сервер Argus19 17.10.2026 Локальный http сервер На работе, на двух локальных компьютерах круглосуточно работают программы опроса приборов с записью в книги Excel,которые раз в сутки записываются на сервер компании. Т. к. . . .	Копировать Windows на новый диск на UEFI damix 17.10.2026 https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .
Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .

@Tinoo -1 / 0 / 0 Регистрация: 09.03.2011 Сообщений: 75
	29.06.2011, 13:50 [ТС]
	Busine2009, ААааааааааааа ты ГЕНИЙ !!!!!!!! )))))) Скажи, как можно тебя отблагодарить ? 0