Макрос импорта из Excel to Word

[groder911]

Здравствуйте, прошу помощи, тема не раз обсуждалась, но тем не менее.
Суть такова, существует база данных со списком людей прошедших обучение (xls), и файл сертификата (doc).
Необходимо макросом создавать документ с набором готовых к печати сертификатов (одним файлом), То есть берется информация из таблицы в экселе и переносится в заданные места в шаблоне сертификата.
Прошу помощи в написании макроса.

(Допустим мы нажимаем на кнопку Пожарные, и создается документ с сертификатами для пожарных, при нажатии на кнопку для Охранников, из той-же БД формируется Документ с сертификатами для охранников.

Была похожая тема с письмами, но тот макрос почему-то не работает.

В архиве БД и шаблоны для 2х сертификатов.
Можно сделать что-то на подобие {фио} {должность} в нужных полях.помечены желтым )
Спасибо.

[EducatedFool]

Эта надстройка для Excel вам поможет:
http://excelvba.ru/programmes/FillDocuments

Надстройка предназначена для формирования (подготовки) документов по шаблонам, с заполнением созданных файлов данными из текущей книги Excel.

В качестве шаблонов могут выступать следующие типы файлов:

• документы Word (расширения DOC, DOCX, DOCM)
• шаблоны Word (расширения DOT, DOTX, DOTM)
• книги Excel (расширения XLS, XLSX, XLSM, XLSB)
• шаблоны Excel (расширения XLT, XLTX, XLTM)
• текстовые документы (расширения TXT, DAT, XML и т.д.)

В качестве исходных данных для заполнения, используется открытый в Excel файл (с таблицей, содержащей строку заголовка)

Одно нажатие кнопки - и будут созданы заполненные файлы Word (по 2 для каждой из выделенных строк)

[groder911]

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

Эта надстройка для Excel вам поможет:
http://excelvba.ru/programmes/FillDocuments



Одно нажатие кнопки - и будут созданы заполненные файлы Word (по 2 для каждой из выделенных строк)

К сожалению нет, необходим более простой и конкретный вариант.
Здесь надстройка, а мне нужен макрос (именно код), который я бы мог сам докрутить в случае надобности. Если кто-то может привести пример кода из надстройки, буду благодарен, так как сам посмотреть я не смог

[groder911]

Была подобная тема, там EducatedFool помогал девушке с программой для составления писем.
Так вот, там написан макрос, но почему-то он при копировании в другой документ не работает.
Объясните почему?

Sub CreateDocs()
    Dim WA As New Word.Application
    Dim WD As Word.Document, ra As Word.Range
    Set WD = WA.Documents.Add(ThisWorkbook.Path & Application.PathSeparator & "øàáëîí.dot")
    With WA.Selection
        .HomeKey Unit:=wdStory: .EndKey Unit:=wdStory, Extend:=wdExtend
        .Copy
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            .Paste
            .EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
            .Find.Execute "{дата}", False, , , , , , , , Format(Now, "dd mmmm yyyy ã."), True
            .EndKey Unit:=wdStory, Extend:=wdExtend
            .Find.Execute "{фио}", False, , , , , , , , Cells(i, 1), True
            .EndKey Unit:=wdStory, Extend:=wdExtend
            .Find.Execute "{должность}", False, , , , , , , , Cells(i, 2), True
            .EndKey Unit:=wdStory, Extend:=wdExtend
            .Find.Execute "{отделение}", False, , , , , , , , Cells(i, 3), True
            .EndKey Unit:=wdStory, Extend:=wdExtend
            .Find.Execute "{оклад}", False, , , , , , , , Cells(i, 4), True
            .EndKey Unit:=wdStory
        Next i
    End With
    WD.SaveAs ThisWorkbook.Path & Application.PathSeparator & "ïèñüìà.doc"
    WD.Close False: WA.Quit False
End Sub

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

[DiemonStar]

Set WD = WA.Documents.Add(ThisWorkbook.Path & Application.PathSeparator & "øàáëîí.dot")

В этой строке прописывается шаблон документа: путь + имя файла который нужно открыть. Если в указанном месте (рядом с таблицей) такого файла не будет, то и работать не будет)

[groder911]

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

В этой строке прописывается шаблон документа: путь + имя файла который нужно открыть. Если в указанном месте (рядом с таблицей) такого файла не будет, то и работать не будет)

Допустим, есть xls файл, в нем первая строчка заполнена ФИО людей, есть шаблон .dot в котором написано: {фио}.
Макрос который заполнит шаблон ФИО из экселевского файла и сохранит в новом документе как будет выглядеть, так?

Sub CreateDocs1()
    Dim WA As New Word.Application
    Dim WD As Word.Document, ra As Word.Range
    Set WD = WA.Documents.Add(ThisWorkbook.Path & Application.PathSeparator & "шаблон.dot")
    With WA.Selection
        .HomeKey Unit:=wdStory: .EndKey Unit:=wdStory, Extend:=wdExtend
        .Copy
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            .Paste
            .EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
            .Find.Execute "{фио}", False, , , , , , , , Cells(i, 1), True
            .EndKey Unit:=wdStory, 
                    Next i
    End With
    WD.SaveAs ThisWorkbook.Path & Application.PathSeparator & "документ.doc"
    WD.Close False: WA.Quit False
End Sub

Так будет? Помогите разобраться пожалуйста!

[DiemonStar]

Так будет?

У меня процедура заработала.

[groder911]

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

У меня процедура заработала.

Да, у меня тоже, спасибо, подскажите пожалуйста, почему макрос принебрегает форматированием шаблона, проще говоря се слепляет, хотя я, чтобы каждая новая страница былп отдельно в шаблоне сделал пустой лист

[groder911]

Все прекрасно заработало, спасибо. Если кому-то понадобится макрос, напишите на мыло groder911@gmail.com

[IgorGO]

Суть такова, существует база данных со списком людей прошедших обучение (xls), и файл сертификата (doc). 
Необходимо макросом создавать документ с набором готовых к печати сертификатов (одним файлом), То есть берется информация из таблицы в экселе и переносится в заданные места в шаблоне сертификата.

Дело в том, что в МСофисе есть готовое средство под Вашу задачу, не требующее ни каких макросов, ключевая слово для поиска "слияние", в 2007 офисе можете посмотреть раздел "Применение слияния для создания и печати писем и других документов", там все пошагово обьяснено

удачи!