Исходный код из видео

Sub main()
Dim wdApp As Object
Dim wdDoc As Object

HomeDir$ = ThisWorkbook.Path
Set wdApp = CreateObject("Word.Application")
i% = 2
Do
If Cells(i%, 1).Value = "" Then Exit Do
If Cells(i%, 1).Value <> "" Then

NPP$ = Cells(i%, 1).Text
ID$ = Cells(i%, 2).Text
Text$ = Cells(i%, 3).Text
SN$ = Cells(i%, 4).Text

DataC$ = Date

FileCopy HomeDir$ + "\template.doc", HomeDir$ + "\" + NPP$ + "_" + ID$ + "_" + DataC$ + ".doc"
Set wdDoc = wdApp.Documents.Open(HomeDir$ + "\" + NPP$ + "_" + ID$ + "_" + DataC$ + ".doc")

On Error GoTo ErrorHandler

temp = Left(Text$, 255)
temp2 = Mid(Text$, 256, 255)
temp3 = Mid(Text$, 512, 255)
temp4 = Mid(Text$, 768, 255)

wdDoc.Range.Find.Execute FindText:="&date", ReplaceWith:=DataC$
wdDoc.Range.Find.Execute FindText:="&id", ReplaceWith:=ID$
wdDoc.Range.Find.Execute FindText:="&text", ReplaceWith:=temp
wdDoc.Range.Find.Execute FindText:="&text2", ReplaceWith:=temp2
wdDoc.Range.Find.Execute FindText:="&text3", ReplaceWith:=temp3
wdDoc.Range.Find.Execute FindText:="&text4", ReplaceWith:=temp4

wdDoc.Range.Find.Execute FindText:="&sn", ReplaceWith:=SN$
wdDoc.Save
wdDoc.Close
End If

i% = i% + 1
Loop
wdApp.Quit
MsgBox "Готово!"

Exit Sub

ErrorHandler:

wdDoc.Save
wdDoc.Close
wdApp.Quit

MsgBox "Не выполнено! " + Error
End Sub

Исходный код из видео - скачать архив с файлами


ZIP архив с файлами


Рекомендуем смотреть видео в полноэкранном режиме, в настойках качества выбирайте 1080 HD, не забывайте подписываться на канал в YouTube, там Вы найдете много интересного видео, которое выходит достаточно часто. Приятного просмотра!

 С уважением, авторы сайта Компьютерапия

Понравилось? Поделись этим видео с друзьями!




Понравилась статья? Поделитесь ею с друзьями и напишите отзыв в комментариях!

Предыдущие статьи

We use cookies on our website. Some of them are essential for the operation of the site, while others help us to improve this site and the user experience (tracking cookies). You can decide for yourself whether you want to allow cookies or not. Please note that if you reject them, you may not be able to use all the functionalities of the site.

Ok