Задать цикл

[eemil]

Здравствуйте, уважаемые. Макрос в Экселе связывает ячейки одной строки с закладками в шаблоне Ворд. Все просто, указываю строку, столбец потом закладку, связываю их. Но строк много и нужно чтобы они автоматически по такому же принципу формировали листы в том же документе (шаблон Ворд).

Sub FT_wd()
Dim WordApp As Object
Dim WordDoc As Object
Dim wb As Workbook, ws As Worksheet

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("FT")
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open("...atx2.doc ")
WordApp.Visible = True


ws.Cells(3, 3).Copy
WordDoc.Bookmarks("kontur").Range.P asteExcelTable True, False, True

ws.Cells(3, 4).Copy
WordDoc.Bookmarks("naim").Range.Pas teExcelTable True, False, True

ws.Cells(3, 24).Copy
WordDoc.Bookmarks("diapazon").Range .PasteExcelTable True, False, True

End Sub


Подскажите как правильно задать цикл, что бы можно было и шаг задавать, и все остальные строки, по типу 3-й, формировали один документ.

[IgorGO]

шаг формируется через Step в операторе for

удачи!

[Aleksandr H.]

Имхо, не будет оно так работать. В документе должны быть только оригинальные закладки, то есть закладка naim может быть только на одном листе.
В цикле если запускать код

ws.Cells(NewRow, NewCol).Copy
WordDoc.Bookmarks("kontur").Range.PasteExcelTable True, False, True

то постоянно будет переписываться только закладка kontur на одном листе.
Лучше и дальше разбираться как работает слияние или, как вариант, создать много файлов а тогда макросом собрать их в одну книгу

[EducatedFool]

Можете попробовать готовое решение
http://excelvba.ru/programmes/FillDocuments

[eemil]

Подскажите в каком месте указать лист "FT" в рабочей книге

Sub FT_wd()
Dim WA As New Word.Application
Dim WD As Word.Document, ra As Word.Range
Dim wb As Workbook, ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("FT")
Set WD = WA.Documents.Add(ThisWorkbook.Path & Application.PathSeparator & "atx2.dot")
With WA.Selection
.HomeKey Unit:=wdStory: .EndKey Unit:=wdStory, Extend:=wdExtend
.Copy
Set wb = ThisWorkbook
Set ws = wb.Worksheets("FT")
For i = 3 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
.Paste
.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{дата;}", False, , , , , , , , Format(Now, "dd mmmm yyyy г"), True
.EndKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{kon}", False, , , , , , , , ws.Cells(i, 3), True
.EndKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{nai}", False, , , , , , , , ws.Cells(i, 4), True
.EndKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{позиция}", False, , , , , , , , ws.Cells(i, 5), True
.EndKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{диапазон}", False, , , , , , , , ws.Cells(i, 6), True
.EndKey Unit:=wdStory
Next i
End With
WD.SaveAs ThisWorkbook.Path & Application.PathSeparator & "yes2.doc"
WD.Close False: WA.Quit False
End Sub


По всякому пробую, но не получается

[eemil]

Разобрался.. Все работает. Код (тот что выше) рабочий, формирует множество листов в Word из данных таблицы Excel. Может кому еще пригодится

[eemil]

Подскажите пожалуйста, куда вставить const для закладок {zak1}..{zak6} и столбцов?


Sub FT_wd()
Dim WA As Word.Application
Dim WD As Word.Document, ra As Word.Range
Dim wb As Workbook, ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Worksheets("FT")
Set WA = CreateObject("Word.Application")
Set WD = WA.Documents.Open("D:\atx2.dot")
WA.Visible = True

With WA.Selection
.HomeKey Unit:=wdStory: .EndKey Unit:=wdStory, Extend:=wdExtend
.Copy
Set wb = ThisWorkbook
Set ws = wb.Worksheets("FT")
For i = 3 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row Step 2

.Paste
.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{zak1}", False, , , , , , , , ws.Cells(i, 3), True

.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{zak2}", False, , , , , , , , ws.Cells(i, 4), True

.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{zak3}", False, , , , , , , , ws.Cells(i, 7), True

.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{zak4}", False, , , , , , , , ws.Cells(i, 10), True

.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{zak5}", False, , , , , , , , ws.Cells(i, 11), True

.EndKey Unit:=wdStory: .HomeKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute "{zak6}", False, , , , , , , , ws.Cells(i, 12), True

.EndKey Unit:=wdStory
Next i
End With

End Sub

[Казанский]

кросс http://www.cyberforum.ru/vba/thread1652996.html