Новости
Видео
Microsoft
Windows 10
Железо
Программы
Форум

Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Макрос создания документов Word по данным таблицы Excel

Ответить
Настройки темы
VBA - Макрос создания документов Word по данным таблицы Excel

Пользователь


Сообщения: 63
Благодарности: 0

Профиль | Отправить PM | Цитировать

Изменения
Автор: RusGor
Дата: 24-09-2012
Уважаемые программисты прошу помочь!
Нужно на работе автоматизировать свою работу, чтобы не заниматься однообразной работой.
Нашел на сайте готовый макрос http://excelvba.ru/code/CreateWordDocuments
Но не могу до конца разобраться как подстроить его под себя.
1) Как сделать так чтобы макрос создавал документы Word и вставлял данные со второй строки в Excel
Я так понимаю нужно сделать следующие исправления (я их выделил жирным)

r = Cells(Rows.Count, "A").End(xlUp).row: rc = r - 1
If rc < 1 Then MsgBox "Строк для обработки не найдено", vbCritical: Exit Sub

pi.Show "Формирование договоров": pi.ShowPercents = True: s1 = 10: s2 = 90: p = s1: a = (s2 - s1) / rc
pi.StartNewAction , s1, "Запуск приложения Microsoft Word"

' Dim WA As Word.Application, WD As Word.Document: Set WA = New Word.Application ' c подключением библиотеки Word
Dim WA As Object, WD As Object: Set WA = CreateObject("Word.Application") ' без подключения библиотеки Word

For Each row In ActiveSheet.Rows("2:" & r)

2) Как заставить макрос чтобы при сохранении документов Word из шаблона, сохранял их в одну определенную папку а не создавал при каждом выполнении новую
пример Договоры, сформированные 06-06-2011 в 12-26-44

3) Как заставить макрос, чтобы при создании нового документа, имя документа создавалось не по трем столбцам а по одному (то есть по столбцу 1)
4) Как сделать так чтобы формировались документы не по всем строчкам, а только по нужным с помощью макроса например если допустим в столбце А стоит слово noPrint, то заявки не создаются, если ни чего не стоит то создаются.

Жду решений, заранее спасибо!

Сам макрос ниже


Const ИмяФайлаШаблона = "шаблон.dot"
Const КоличествоОбрабатываемыхСтолбцов = 8
Const РасширениеСоздаваемыхФайлов = ".doc"

Sub СформироватьДоговоры()
ПутьШаблона = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, ИмяФайлаШаблона)
НоваяПапка = NewFolderName & Application.PathSeparator
Dim row As Range, pi As New ProgressIndicator
r = Cells(Rows.Count, "A").End(xlUp).row: rc = r - 2
If rc < 1 Then MsgBox "Строк для обработки не найдено", vbCritical: Exit Sub

pi.Show "Формирование договоров": pi.ShowPercents = True: s1 = 10: s2 = 90: p = s1: a = (s2 - s1) / rc
pi.StartNewAction , s1, "Запуск приложения Microsoft Word"

' Dim WA As Word.Application, WD As Word.Document: Set WA = New Word.Application ' c подключением библиотеки Word
Dim WA As Object, WD As Object: Set WA = CreateObject("Word.Application") ' без подключения библиотеки Word

For Each row In ActiveSheet.Rows("3:" & r)
With row
ФИО = Trim$(.Cells(1)) & " " & Trim$(.Cells(2)) & " " & Trim$(.Cells(3))
Filename = НоваяПапка & ФИО & РасширениеСоздаваемыхФайлов

pi.StartNewAction p, p + a / 3, "Создание нового файла на основании шаблона", ФИО
Set WD = WA.Documents.Add(ПутьШаблона): DoEvents

pi.StartNewAction p + a / 3, p + a * 2 / 3, "Замена данных ...", ФИО
For i = 1 To КоличествоОбрабатываемыхСтолбцов
FindText = Cells(1, i): ReplaceText = Trim$(.Cells(i))

' так почему-то заменяет не всё (не затрагивает таблицу)
'WA.Selection.Find.Execute FindText, , , , , , , wdFindContinue, False, ReplaceText, True

pi.line3 = "Заменяется поле " & FindText
With WD.Range.Find
.Text = FindText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = 1
.Format = False: .MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
End With
DoEvents
Next i
pi.StartNewAction p + a * 2 / 3, p + a, "Сохранение файла ...", ФИО, " "
WD.SaveAs Filename: WD.Close False: DoEvents
p = p + a
End With
Next row

pi.StartNewAction s2, , "Завершение работы приложения Microsoft Word", " ", " "
WA.Quit False: pi.Hide
msg = "Сформировано " & rc & " договоров. Все они находятся в папке" & vbNewLine & НоваяПапка
MsgBox msg, vbInformation, "Готово"
End Sub










Function NewFolderName() As String
NewFolderName = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Договоры, сформированные " & Get_Now)
MkDir NewFolderName
End Function

Function Get_Date() As String: Get_Date = Replace(Replace(DateValue(Now), "/", "-"), ".", "-"): End Function
Function Get_Time() As String: Get_Time = Replace(TimeValue(Now), ":", "-"): End Function
Function Get_Now() As String: Get_Now = Get_Date & " в " & Get_Time: End Function

Отправлено: 12:06, 22-03-2012

 

Пользователь


Сообщения: 63
Благодарности: 0

Профиль | Отправить PM | Цитировать

5) И еще один момент забыл указать как сделать так, чтобы выборка из Excel была ни только с первого листа, а со всех листов в книге.

Отправлено: 12:13, 22-03-2012 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

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


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать

RusGor, расскажите своими словами, что Вам нужно. Приведите пример рабочей книги Excel.

Отправлено: 18:07, 22-03-2012 | #3


Новый участник


Сообщения: 4
Благодарности: 0

Профиль | Отправить PM | Цитировать

Есть примерно такая же задача, кто готов взяться?

Отправлено: 07:14, 20-07-2023 | #4


Старожил


Сообщения: 412
Благодарности: 19

Профиль | Отправить PM | Цитировать

Всем привет. А вам обязательно делать это скриптами и макросом?

Если я правильно понял задачу, то у меня была такая же и я ее решал вот так.
https://www.youtube.com/watch?v=spmtcywy9Wo

Стандартный функционал и скрипты не нужны.

Отправлено: 11:17, 01-11-2023 | #5



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Макрос создания документов Word по данным таблицы Excel

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
VBA - Помогите написать макрос в Excel, экспорт данных из Excel в Word. E.v.g Программирование и базы данных 7 03-05-2018 22:18
Просмотрщики документов Word и Excel от компании Microsoft _syd_ Автоматическая установка приложений 1 27-11-2017 05:45
2003/XP/2000 - excel таблица из другой excel таблицы sesves Microsoft Office (Word, Excel, Outlook и т.д.) 2 16-03-2012 01:24
2007 - Слияние документов Word Excel NeoVit Microsoft Office (Word, Excel, Outlook и т.д.) 4 12-02-2012 17:02
Разное - Макрос Excel. KiriJolit Microsoft Office (Word, Excel, Outlook и т.д.) 0 02-12-2010 23:19


« Предыдущая тема | Следующая тема »


 
Переход