|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
02.11.2016, 20:25 | #1 |
Новичок
Джуниор
Регистрация: 31.10.2016
Сообщений: 1
|
Автозаполнение договоров
Всем добрый вечер!
прошу помощи, есть 4 документа шаблона Word с разными договорами и своим именем, есть таблица в Excel с нужными данными подставляемыми в свой договор. необходимо чтобы при выполнении макроса, а именно выделяя нужную ячейку с тем именем, которым надо сохранить в формате .docx, но он сохраняет только то что я укажу: FName = ob1.Cells(f_r, stb) objDoc.SaveAs Filename:=path_f & "\Договор_" & FName я бы хотел чтобы когда я хочу сохранить файл, то он бы сохранялся с именем документа (шаблона) с именем той выделенной ячейкой, а так же создавалась одноименная папка в нужном мне месте. Sub Generator() Dim ObWord As Word.Application Dim objDoc As Word.Document Dim file As String Set ob1 = ActiveWorkbook.ActiveSheet ' теперь переменная ob1 будет содержать ссылку на текущий лист активной книги f_r = Selection.Row ' определяем номер выбранной строки stb = Selection.Column ' определяем номер выбранного столбца f_c = Selection.CurrentRegion.Columns(Sel ection.CurrentRegion.Columns.Count) .Column ' определяем номер последнего столбца в данной таблице path_f = ThisWorkbook.Path 'определяем текущую папку file = Application.GetOpenFilename("Excel Files (*.docx;*.doc), *docx;*.doc") ' открывается диалоговое окно "Открытие документа" If Dir(file) = Empty Then Exit Sub Else ' запускаем Word, открываем выбранный документ Set ObjWord = CreateObject("Word.Application") With ObjWord .Visible = True .Documents.Open Filename:=file Set objDoc = .ActiveDocument End With With objDoc.Range For j = 1 To f_c ' цикл по всем столбцам таблицы isk_zn = ob1.Cells(1, j) 'искомое значение - находится в первой строке нашей таблицы zamen_zn = ob1.Cells(f_r, j) 'значение для замены .Find.ClearFormatting .Find.Replacement.ClearFormatting 'осуществляем замену With .Find .Text = isk_zn .Replacement.Text = zamen_zn .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With .Find.Execute Replace:=wdReplaceAll Next j ' сохраняем документ в том же месте что и книга с макросом, имя документа - значение из выделенной ячейки FName = ob1.Cells(f_r, stb) objDoc.SaveAs Filename:=path_f & "\" & FName objDoc.Close ObjWord.Quit End With Set objDoc = Nothing Set ObjWord = Nothing ob1.Activate End If End Sub |
03.11.2016, 00:44 | #2 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,858
|
Посмотрите готовое решение
http://excelvba.ru/programmes/FillDocuments В этой надстройке есть весь необходимый вам функционал. |
Опции темы | Поиск в этой теме |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
оплата договоров | АлексейСуров | Microsoft Office Access | 1 | 10.03.2013 01:07 |
БАза договоров | Kukuska | Microsoft Office Access | 0 | 27.09.2012 15:00 |
Поквартальная разбивка сумм договоров | swetikhoney | Microsoft Office Excel | 2 | 20.10.2011 16:04 |
Автоматизация договоров | Romuald | Microsoft Office Excel | 15 | 20.04.2010 09:21 |
Автоматическая нумерация договоров, добавление контрагентов | kitten2 | Microsoft Office Word | 1 | 22.12.2009 15:24 |