Перенос большого количества данных из Excel в Word

[shanemac51]

Если о макросе то разбиение текста на фрагменты совсем неудобно, учитывая что почти половина значений превышает 255 символов.
=================
шаблон большой, но простейший
не раздумывая
--в екселе ввела бы порядковый номер и флажок(возможны перестановки и удаления
--программное создание НТМ-документа в стандартных тегах для выбранных строк
--открытие НТМ в ворде и запоминание как patent.doc

[Ksardex]

shanemac51, возможно так проще, но я понятия не имею как это все сделать. Задача: автоматическое заполнение шаблона из базы. Макрос - все что пришло на ум.

[maksim_serg]

макрос второе удачное решение после рук
Ну что у Вас получилось?

[Ksardex]

Sub Вставить_в_отчет()

Dim WA As Object, WD As Object

Set WA = CreateObject("Word.Application")
Set WD = WA.Documents.Open("C:\ШАБЛОНЫ\связка\shablon.docx")

WD.Range.Find.Execute FindText:="{$НОМПАТЕНТ01}", ReplaceWith:=Cells(2, 2), Replace:=2
WD.Range.Find.Execute FindText:="{$Наименовпатент01}", ReplaceWith:=Cells(2, 3), Replace:=2
WD.Range.Find.Execute FindText:="{$Названпатент01}", ReplaceWith:=Cells(2, 4), Replace:=2
WD.Range.Find.Execute FindText:="{$МПКпатент01}", ReplaceWith:=Cells(2, 5), Replace:=2
WD.Range.Find.Execute FindText:="{$датапублпатент01}", ReplaceWith:=Cells(2, 6), Replace:=2
WD.Range.Find.Execute FindText:="{$Статуспатент01}", ReplaceWith:=Cells(2, 7), Replace:=2
WD.Range.Find.Execute FindText:="{$Имязаявит01}", ReplaceWith:=Cells(2, 8), Replace:=2
WD.Range.Find.Execute FindText:="{$Номерзаявк01}", ReplaceWith:=Cells(2, 9), Replace:=2
WD.Range.Find.Execute FindText:="{$Датаподачзаяв01}", ReplaceWith:=Cells(2, 10), Replace:=2
WA.Visible = True
Set WA = Nothing

End Sub

Как то так. Осталось дописать макрос для остальных строк.

Руками все это переносить слишком долго и неудобно. Последний отчет (120 патентов) я заполнял день. Делалось это руками с помощью функции автозамены в worde. А перед этим пол дня вносил данные в таблицу.

[maksim_serg]

WD.Range.Find.Execute FindText:="{01}", ReplaceWith:=Cells(2, 2), Replace:=2
WD.Range.Find.Execute FindText:="{$Наименовпатент01}", ReplaceWith:=Cells(2, 3), Replace:=2
WD.Range.Find.Execute FindText:="{$Названпатент01}", ReplaceWith:=Cells(2, 4), Replace:=2
WD.Range.Find.Execute FindText:="{$МПКпатент01}", ReplaceWith:=Cells(2, 5), Replace:=2
WD.Range.Find.Execute FindText:="{$датапублпатент01}", ReplaceWith:=Cells(2, 6), Replace:=2
WD.Range.Find.Execute FindText:="{$Статуспатент01}", ReplaceWith:=Cells(2, 7), Replace:=2
WD.Range.Find.Execute FindText:="{$Имязаявит01}", ReplaceWith:=Cells(2, 8), Replace:=2
WD.Range.Find.Execute FindText:="{$Датаподачзаяв01}", ReplaceWith:=Cells(2, 10), Replace:=2

Это что?????
переименуйте заголовки столбцов, например столбец2="НОМПАТЕНТ"
напишите цикл

for r=2 to 10 ' (число строк)
for c=1 to 10 ' (число столбцов)
  WD.Range.Find.Execute FindText:="{$" & Cells(1, c) & Cells(r, 1) & "}", ReplaceWith:=Cells(r, c), Replace:=2
next
next

[Ksardex]

В шаблоне названия [НОМПАТЕНТ01], [НОМПАТЕНТ02] и т.д.. Это как раз и нужно заменить.

[Ksardex]

С циклом что-то не понял что есть что...

[maksim_serg]

Вот, посмотрите. распакуйте архив. и в макросе поменяйте путь к МОЕМУ шаблону

[Ksardex]

Сообщение от maksim_serg

Вот, посмотрите. распакуйте архив. и в макросе поменяйте путь к МОЕМУ шаблону

Да, отлично, вот только что если патентов не 100, а скажем 40? замена в этом случае пойдет уже не там где надо...


---
А, нет, все понял... да именно это и нужно! Благодарю!

[maksim_serg]

замена в этом случае пойдет уже не там где надо...
с какого это, я извиняюсь