[QUOTE]>Ressi пишет:
Ален ,выложи, плиз в библиотеку[/QUOTE]
вот ссылочка http://help-s.ru/library/detail.php?ID=769522

А теперь обещанный макрос. К примеру у Вас есть база клиентов в Экселе, нужно для всех клиентов составить договора. Шаблон договора в Ворде. Если подставлять нужные значения из Экселя в Ворд простым копированием - это утомительно, особенно если таких договоров пару сотен, да и ошибок при таком способе не избежать.

Вот пример простого и универсального макроса.
<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

[QUOTE]>Beerman пишет:
А на этом сайте вобще с заказами какая то напряженка...[/QUOTE]
Ну, сейчас "не сезон"...

чуть попозже выложу макрос как раз на эту тему - тем кому приходится иметь дело с договорами и другими различными документами в Word - очень простое и универсальное решение

Но на сколько я помню - для вас с мужем это был еще и счастливый день календаря ;-)

А этот макрос меня попросила написать подруга, у нее были сделаны презентации с животными, насекомыми и т.д., она показывала их своему малышу, а потом просила его назвать то или иное животное. И т.к. малыш быстро выучил в какой последовательности идут картинки одна за другой - он называл маме животных даже не глядя в экран. Вот мама и решила усложнить ему задачу, попросив меня написать макрос который бы выдавал слайды в случайном порядке. Макрос называется mixer - есть кнопка на панели инструментов либо же можно запустить Сервис - Макрос - Макросы - mixer.
Если макросы не работают - значит уровень безопасности - "высокий", нужно выставить "средний" и снова открыть макрос.
Скачать можно здесь
http://help-s.ru/library/detail.php?ID=758294

Ничего красивого я пока не придумала - все "приземленное". Но идея хорошая - надо будет подумать.

Мы всем отделом (я и мой начальник) решали кроссворды СУДОКУ ежедневно. Без этого рабочий день не начинался. Выпив чашку чая (или кофе) с шоколадкой и разгадав кроссворд мы приступали к выполнению служебных обязанностей. Тогда и возникла идея написать макрос по генерированию таких кроссвордов. Мое увлечение кроссвордами прошло, а макрос остался.
[IMG]http://programilla.com/uploads/images/4/3/c/8/7/d2598366e3.jpg[/IMG]
Скачать можно здесь http://help-s.ru/library/detail.php?ID=756899

Иногда приходится копировать информацию из сайта и вставлять ее в Excel. На первый взгляд, нет ничего сложного в этих нехитрых действиях – копирование – переход в Excel, поиск свободной ячейки, вставка данных. Но когда эти действия приходится совершать несколько десятков а то и сотни раз – это немного утомляет и даже раздражает. И очень хочется свести к минимуму количество действий в этой несложной схеме.
А именно, чтобы при нажатии стандартного сочетания клавиш Ctrl + C — скопированное значение само помещалось в нужный файл в нужную ячейку.
Для реализации данной задачи напишем процедуру ClipboardShow, которая проверяет содержимое буфера обмена каждую секунду, и если оно отличалось от предыдущего значения, то заносится в файл в ячейку, следующую за последней заполненной.
[CODE]Dim Clipboard As New DataObject
Global text0 As Variant
Sub ClipboardShow()
Application.OnTime Now + TimeValue("00:00:01"), "ClipboardShow"
Dim myRange As Range
Dim text1 As Variant
On Error Resume Next
' Чтобы считать текст из буфера обмена
Clipboard.GetFromClipboard
text1 = Clipboard.GetText
If text0 <> text1 And text1 <> "" Then
text0 = text1
' ищем подходящую ячейку
Set myRange = ThisWorkbook.Worksheets(1).Range("A1:J50")
pusto = ""
Set rng = myRange.Find(What:=pusto, LookIn:=xlValues, SearchOrder:=xlByColumns)
If Not (rng Is Nothing) Then
r = rng.Row
c = rng.Column
ThisWorkbook.Worksheets(1).Cells(r, c) = text0
Clipboard.SetText ""
Clipboard.PutInClipboard
Else
MsgBox "Пустых ячеек в диапазоне больше нет": Call ClipboardStop: Exit Sub
End If
End If
End Sub
'процедура остановки работы макроса
Sub ClipboardStop()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "ClipboardShow", , False
End Sub
[/CODE]
Теперь скопированное значение из буфера обмена будет вставляться последовательно ячейка за ячейкой в нужный диапазон.
В нашем примере этот диапазон содержит 50 строк и 10 столбцов («A1:J50»).
Думаю, данная процедура облегчит жизнь тем, кому приходится собирать различную информацию из сайтов или других программ. Нет необходимости прыгать из программы в программу, из всех действий оставим только копирование, все остальное макрос сделает сам.

Примечание: для работы с буфером обмена должна быть установлена ссылка на библиотеку Microsoft Forms 2.0 Object Library

Не буду скрывать, VBA - мой любимый язык программирования. Сюда я хочу поместить некоторые из своих программ. Буду рада, если кто-нибудь меня поддержит и добавит сюда что-то интересное, написанное на VBA.

[QUOTE]>Irhen пишет:
вот кто на самом деле является исполнителем контрольных работ[/QUOTE]
Может и себе кота ученного завести...

[QUOTE]>Ressi пишет:
Вся страна у телевизов заряжала банки с водой у Чумака. smile:super: А Кашпировский?![/QUOTE]
О, точно! Мы детьми были - как только начиналась передача - мама нас загоняла к телевизору и нужно было высидеть весь сеанс. Ой, как тяжело нам это давалось - полчаса на "непонятного дядю" в телевизоре смотреть и слушать "у вас рассасываются швы... и исчезает головная боль" :rotate:.

Моим бабушке и дедушки пришло письмо, что они якобы выиграли джип. Они позвонили моему брату, который как раз оформлял кредит на автомобиль и уговаривали его подождать, пока "джип находится в пути к их дому". Естественно, нужно было купить какие-то 3 книги по стоимости в 5 раз выше реальной. Я узнала про эту авантюру, пыталась вразумить, говорила, что это развод. Но, они хотели в это верить - поэтому книги купили, потом снова пришло письмо - снова нужно было купить книги - и так 3 раза, очень уж им хотелось "помочь внуку - выиграть для него автомобиль". Письма были красивыми, яркими, "правдивыми". Жаль стариков, они после этого развода долго отходили, в этом возрасте уже тяжело переживать такие драмы.

вот - поднимает эндорфин - http://video.mail.ru/mail/indeetz_1971/164/163.html

[QUOTE]>Ressi пишет:
А сама пробовала?[/QUOTE]
нет, я мысленно представила, как меняется мое лицо с каждой секундой - и мне уже стало весело.
Сейчас еще мысленно спортом позанимаюсь :)