как из Excel создать документ Word на основе шаблона?

[Andrey_K]

Раньше приходилось иметь дело только с Excel, но теперь попросили сваять макрос для обработки документов в Word.
Собственно задача как я понял по поиску довольно распространенная, а именно, есть бланк договора (договор.dot) и в него надо из excel перетащить данные (причем некоторые из них динамические).
Собственно уперся с самого начала в следующее, пишу приблизительно это:

Dim objWord As New Word.Application
Dim Doc As Word.Document

Set Doc = objWord.Documents.Add(Template:="I:\договор.dot")

при первом заходе всё без проблем отрабатывается, НО запуская повторно - выскакивает окошко "редактирование договор.dot запрещено и три варианта выбора, чтение-уведомить-отмена"
И что это за бред? я же его .dot не открывал, а просил создать новый файл на его основе????? причем если выбрать отмена, то начинается куча конфликтов при закрытии как и договор.dot так и normal.dot (а этот то тут при чем)
Если меняю код на:

Dim Doc As Word.Document

Set Doc = Documents.Add(Template:="I:\договор.dot")

то всё работает как надо, только при условии что уже одна копия созданная на основе этого шаблона открыта. Если запускаю когда ворд закрыт то выскакивает ошибка 429 (активХ компонент не может создать объект)

Собственно вопрос: как правильно из екселя создать вордовский документ на основе шаблона. (причем при повторном запуске чтобы не появлялось это окошко про редактирование запрещено)????
:cry

[KL]

У меня, след. коды работают без проблем (Office2003):

Option Explicit

Код: Выделить всё

' Establish a reference to Microsoft Word library first
Sub test()
    Dim objWDApp As Word.Application
    Dim objWDDoc As Word.Document
    Dim blnQuitApp As Boolean
   
    ' Начинаем с попытки перехватить уже открытый Word
    ' и присвоить его переменной objWDApp
    ' Оповещение об ошибках на это время прерываем.
    ' Главное - потом не забыть его опять включить (GoTo 0)!
    On Error Resume Next
    Set objWDApp = GetObject(, "Word.Application")
    On Error GoTo 0

    ' Если в предыдущем блоке все-таки произошла ошибка,
    ' то Word не был открыт и переменной objWDApp
    ' ничего не присвоилось (Nothing). Тогда мы открываем
    ' Word сами, а заодно помечаем себе, что раз уж мы
    ' его открыли, то по окончании работы неплохо бы и
    ' закрыть (blnQuitApp).
    If objWDApp Is Nothing Then
        Set objWDApp = CreateObject("Word.Application")
        blnQuitApp = True
    End If
   
    ' Если очень хочется, можем сделать вновь открытый
    ' Word видимым, но лучше не надо для скорости.
    ' objWDApp.Visible = True
   
    ' Создаем документ по шаблону и
    ' присваиваем его переменной objWDDoc
    Set objWDDoc = objWDApp.Documents.Add(Template:="I:\договор.dot")
   
    ' Производим наши манипуляции с документом
    MsgBox objWDDoc.Name

    ' Закрываем документ. Здесь я не сохраняю
    ' изменений (False).
    objWDDoc.Close False
   
    ' Создаем новый документ по шаблону и
    ' опять присваиваем его переменной objWDDoc
    Set objWDDoc = objWDApp.Documents.Add(Template:="I:\договор.dot")

    ' Производим наши манипуляции с документом
    MsgBox objWDDoc.Name

    ' Закрываем документ. Здесь я опять-таки
    ' не сохраняю изменений (False).
    objWDDoc.Close False
   
    ' Начинаем уборку за собой:

    ' Высвобождаем переменную objWDDoc
    Set objWDDoc = Nothing
   
    ' Если Word не был открыт до нас, то
    ' мы его закрываем.
    If blnQuitApp Then objWDApp.Quit

    ' Ну и высвобождаем переменную objWDApp
    Set objWDApp = Nothing

End Sub

Код: Выделить всё

Option Explicit

' Establish a reference to Microsoft Word library first
Sub test()
    Dim objWDApp As Word.Application
    Dim objWDDoc1 As Word.Document
    Dim objWDDoc2 As Word.Document
    Dim blnQuitApp As Boolean
   
    On Error Resume Next
    Set objWDApp = GetObject(, "Word.Application")
    On Error GoTo 0
   
    If objWDApp Is Nothing Then
        Set objWDApp = CreateObject("Word.Application")
        blnQuitApp = True
    End If
   
    'objWDApp.Visible = True
   
    Set objWDDoc1 = objWDApp.Documents.Add(Template:="I:\договор.dot")
    Set objWDDoc2 = objWDApp.Documents.Add(Template:="I:\договор.dot")
   
    MsgBox objWDDoc1.Name
    MsgBox objWDDoc2.Name
   
    objWDDoc1.Close False
    objWDDoc2.Close False
   
    Set objWDDoc1 = Nothing
    Set objWDDoc2 = Nothing
   
    If blnQuitApp Then objWDApp.Quit
    Set objWDApp = Nothing

End Sub

[Andrey_K]

Пасибка, почти разобрался....

Как я понял главное вот это было написать:
On Error Resume Next
Set objWDApp = GetObject(, "Word.Application")
On Error GoTo 0

Кстати, а что в этом коде происходит?

[Goettsch]

to Andrey_K

Кстати, а что в этом коде происходит?

Код: Выделить всё

On Error Resume Next ' -- [1]
Set objWDApp = GetObject(, "Word.Application") ' -- [2]
On Error GoTo 0 ' -- [3]


[1] Включаем перехват ошибок, при этом если произойдет ошибка, то она будет проигнорирована и выполнение перейдет к следующей строке после строки, вызвавшей ошибку.

[2] вызов функции GetObject с опущенным первым аргументом (аргумент pathname:=) — если в данный момент Word запущен, то в переменную objWDApp записывается ссылка на Word; если же Word НЕ запущен, то будет ошибка (ее номер 429), в данном случае, однако, ничего не произойдет, так как мы в строке [1] включили игнорирование ошибок.

[3] Игнорирование ошибок отключается, теперь при возникновении ошибки VBA снова будет выдавать соответствующие сообщения.

[KL]

Пасибка, почти разобрался....

Как я понял главное вот это было написать:
On Error Resume Next
Set objWDApp = GetObject(, "Word.Application")
On Error GoTo 0

Кстати, а что в этом коде происходит?

В дополнение к комментариям Goettsch, см. мои комментарии внутри первого макроса в моем первоначальном сообщении.