Ален ,выложи, плиз в библиотеку[/QUOTE]
вот ссылочка http://help-s.ru/library/detail.php?ID=769522
Лучшие авторы
со всего интернета
Более 1 000 положительных отзывов
Мы поможем вам,
Или вернем деньги
29.08.2011 00:16:47
А теперь обещанный макрос. К примеру у Вас есть база клиентов в Экселе, нужно для всех клиентов составить договора. Шаблон договора в Ворде. Если подставлять нужные значения из Экселя в Ворд простым копированием - это утомительно, особенно если таких договоров пару сотен, да и ошибок при таком способе не избежать.
Вот пример простого и универсального макроса. <code>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(Selection.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 </code> Для его работы нужно подготовить шаблон вордовского документа, а в шапке таблицы Эксель названия полей взять в скобки, можно квадратные, можно фигурные, делается это для того, чтобы макрос не сделал "ненужную замену". К примеру наша база данных выглядит так: <img src="http://programilla.com/uploads/images/f/2/0/b/7/24475728bf.png" > Тогда вордовский документ должен выглядеть так <img src="http://programilla.com/uploads/images/3/5/1/8/7/18efbf30bc.png" > Выбираем любую строку и запускаем макрос. К примеру если на момент запуска макроса была выделена ячейка С3, т.е. "ЧП Новичок", то результат будет следующим <img src="http://programilla.com/uploads/images/e/0/0/f/7/a1e865870b.png" > Для работы макроса нужно чтобы была установлена ссылка на библиотеку Microsoft Word 11.0 Object Library
Изменено: alyon_ka - 29.08.2011 00:18:21
|
|
|
Случайное стихотворение
Проверка на прочность.
|
|