Всем добрый день. Требуется Ваша помощь в решении одной задачки. В общем имеется одна табличка из которой нужно вставить данные в определенное место в документ Microsoft Word. Задача вроде бы решена, хотя возможно и криво. Но проблема в том, что на выходе теряется форматирование исходного файла образца. Подскажите пожалуйста,как можно решить эту проблему? Всем откликнувшимся заранее огромное спасибо!
[вложение удалено администратором]
Для замены используйте метод "Find" программы "Word":
Макрос
Sub dover()
Dim wdApp As Object, wdDoc As Object
Dim FIO$, GOROD$, SER$, NUM$, HomeDir$, i&
'1. Запись пути файла-результата в переменную.
HomeDir = ThisWorkbook.Path
'2. Запуск программы "Word".
Set wdApp = CreateObject(Class:="Word.Application")
'3.
' Движение по эксель-листу.
For i = 3 To 5 Step 1
'1) Копирование данных из эксель в переменные.
FIO = Cells(i, 2).Value
GOROD = Cells(i, 3).Value
SER = Cells(i, 4).Value
NUM = Cells(i, 5).Value
'2) Создание файла-результата.
FileCopy HomeDir + "\dover.doc", HomeDir + "\" + FIO + ".doc"
'3) Открытие файла-результата.
Set wdDoc = wdApp.Documents.Open(HomeDir + "\" + FIO + ".doc")
'4) Замена.
' Replace:=2 - wdReplaceAll
wdDoc.Range.Find.Execute FindText:="&D", ReplaceWith:=Day(Now), Replace:=2
wdDoc.Range.Find.Execute FindText:="&M", ReplaceWith:=Month(Now), Replace:=2
wdDoc.Range.Find.Execute FindText:="&Y", ReplaceWith:=Year(Now), Replace:=2
wdDoc.Range.Find.Execute FindText:="&GOROD", ReplaceWith:=GOROD, Replace:=2
wdDoc.Range.Find.Execute FindText:="&FIO", ReplaceWith:=FIO, Replace:=2
wdDoc.Range.Find.Execute FindText:="&NUM", ReplaceWith:=NUM, Replace:=2
wdDoc.Range.Find.Execute FindText:="&SER", ReplaceWith:=SER, Replace:=2
'5) Закрытие файла-результата.
' SaveChanges:=-1 - wdSaveChanges
wdDoc.Close SaveChanges:=-1
Next i
'4. Закрытие программы "Word".
wdApp.Quit
'5. Сообщение.
MsgBox "ГОТОВО!", vbInformation
End Sub
Спасибо большое. А подскажите пожалуйста, возможно ли сделать так, чтобы все доверенности формировались в одном документе word на отдельных листах.
Макрос
Sub dover()
Dim wdApp As Object, wdDoc As Object
Dim FIO$, GOROD$, SER$, NUM$, HomeDir$, i&, lngStart&
'1. Запись в переменную пути для файла-результата.
HomeDir = ThisWorkbook.Path
'2. Запуск программы "Word".
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Visible = True
'3. Создание файла-результата.
FileCopy HomeDir + "\dover.doc", HomeDir + "\" + "файл-результат" + ".doc"
'4. Открытие файла-результата.
Set wdDoc = wdApp.Documents.Open(HomeDir + "\" + "файл-результат" + ".doc")
'5. Очистка файла-результата (чтобы упростить код).
wdDoc.Range.Text = ""
'6.
' Движение по эксель-листу.
For i = 3 To 5 Step 1
'1) Создание страницы. Если это первый раз, то не нужно создавать страницу.
If wdDoc.Range.Text <> Chr(13) Then
wdDoc.Range(wdDoc.Range.End - 1, wdDoc.Range.End - 1).InsertBreak Type:=0
End If
'2) Запоминание позиции:
'1) куда вставить новые данные;
'2) откуда будет осуществляться поиск и замена.
lngStart = wdDoc.Range.End - 1
'3) Копирование данных в файл-результат из файла-шаблона.
wdDoc.Range(lngStart, lngStart).InsertFile Filename:=HomeDir + "\dover.doc", Link:=False
'4) Копирование данных из эксель в переменные.
FIO = Cells(i, 2).Value
GOROD = Cells(i, 3).Value
SER = Cells(i, 4).Value
NUM = Cells(i, 5).Value
'5) Замена.
' Replace:=2 - wdReplaceAll
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&D", ReplaceWith:=Day(Now), Replace:=2
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&M", ReplaceWith:=Month(Now), Replace:=2
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&Y", ReplaceWith:=Year(Now), Replace:=2
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&GOROD", ReplaceWith:=GOROD, Replace:=2
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&FIO", ReplaceWith:=FIO, Replace:=2
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&NUM", ReplaceWith:=NUM, Replace:=2
wdDoc.Range(lngStart, lngStart).Find.Execute FindText:="&SER", ReplaceWith:=SER, Replace:=2
Next i
'7. Закрытие файла-результата.
' SaveChanges:=-1 - wdSaveChanges
wdDoc.Close SaveChanges:=-1
'8. Закрытие программы "Word".
wdApp.Quit
'9. Сообщение.
MsgBox "ГОТОВО!", vbInformation
End Sub