вывод данных Excel в текстовые документы

У меня есть файл excel, который мне нужно вывести на текстовые документы, мне нужно столько текстовых документов, сколько строк на листе.

Файл excel выглядит так:

<style type="text/css"> .tg { border-collapse: collapse; border-spacing: 0; } .tg td { font-family: Arial, sans-serif; font-size: 14px; padding: 10px 5px; border-style: solid; border-width: 1px; overflow: hidden; word-break: normal; } .tg th { font-family: Arial, sans-serif; font-size: 14px; font-weight: normal; padding: 10px 5px; border-style: solid; border-width: 1px; overflow: hidden; word-break: normal; } .tg .tg-yw4l { vertical-align: top } </style> <table class="tg"> <tr> <th class="tg-yw4l">Unit</th> <th class="tg-yw4l">subject</th> <th class="tg-yw4l">Answer1</th> <th class="tg-yw4l">Answer2</th> <th class="tg-yw4l">observation</th> </tr> <tr> <td class="tg-yw4l">xx/xx</td> <td class="tg-yw4l">change demand</td> <td class="tg-yw4l">ok</td> <td class="tg-yw4l">handling1</td> <td class="tg-yw4l">will be done on...</td> </tr> <tr> <td class="tg-yw4l">xx/xx</td> <td class="tg-yw4l">phone demand</td> <td class="tg-yw4l">nok</td> <td class="tg-yw4l">handlingnok</td> <td class="tg-yw4l">out of phones</td> </tr> <tr> <td class="tg-yw4l">yyy/yyy</td> <td class="tg-yw4l">computer demand</td> <td class="tg-yw4l">ok</td> <td class="tg-yw4l">handling3</td> <td class="tg-yw4l">queued for delivery</td> </tr> </table> 

Фактический код принимает документ шаблона слова и заполняет его значениями, дело в следующем:

1. Он не выводит столько строк, сколько есть в документе (возможно, в переменной UNIT есть конфликт, поэтому я добавил переменную «a», чтобы однозначно назвать файл)

Было бы лучше создать каждый документ уникально, вместо того, чтобы брать шаблон? Есть ли способы сделать это с помощью шаблона?

Вот код VBA:

 Sub reply() Dim wdApp As Object Dim iRow As Long Dim ReferenceDoc As String Dim DocSubject As String Dim unit As String Dim Answer1 As String Dim NmrTicket As String Dim RepType As String Dim wDoc As Word.Document Dim Answer2 As String Dim Observation As String Dim Answer2Val As String Dim j As Integer Dim rep1 As String Dim val1 As String Dim unit2 As String Dim Fname As String Dim unitLast As String Dim a As Integer Dim Datecomision As Date iRow = 5 a = 1 Set wdApp = CreateObject("Word.Application") wdApp.Visible = True Set wDoc = wdApp.Documents.Open("K:\ModlNE2.dotx", ReadOnly:=True) playAlerts = False Sheets("comision").Select Do Until IsEmpty(Cells(iRow, 1)) Sheets("comision").Select ReferenceDoc = Cells(iRow, 1).Value 'ReferenceDoc = DateFeb unitLast = Cells(iRow - 1, 2).Value unit = Cells(iRow, 2).Value DocSubject = Cells(iRow, 3).Value Answer1 = Cells(iRow, 7).Value Observation = Cells(iRow, 8).Value Answer2 = Cells(iRow, 9).Value Datecomision = "03/11/2016" unit2 = Replace(unit, "/", "") unit2 = Replace(unit2, " ", "") ''compare value of answer2 to give the variable a longer text answer for the document j = 2 Sheets("Answer2s").Select Do Until IsEmpty(Cells(j, 1)) rep1 = Cells(j, 1).Value val1 = Cells(j, 2).Value If Answer2 = rep1 Then Answer2Val = val1 End If j = j + 1 Loop j = 1 With wDoc Set wDoc = wdApp.Documents.Open("K:\ModlNE2.dotx", ReadOnly:=True) playAlerts = False .Application.Selection.Find.Text = "<<unit>>" .Application.Selection.Find.Execute .Application.Selection = unit .Application.Selection.EndOf .Application.Selection.Find.Text = "<<Datecomision>>" .Application.Selection.Find.Execute .Application.Selection = Datecomision .Application.Selection.EndOf .Application.Selection.Find.Text = "<<ReferenceDoc>>" .Application.Selection.Find.Execute .Application.Selection = ReferenceDoc .Application.Selection.EndOf .Application.Selection.Find.Text = "<<DocSubject>>" .Application.Selection.Find.Execute .Application.Selection = DocSubject .Application.Selection.EndOf .Application.Selection.Find.Text = "<<Answer1>>" .Application.Selection.Find.Execute .Application.Selection = Answer1 .Application.Selection.EndOf .Application.Selection.Find.Text = "<<Answer2>>." .Application.Selection.Find.Execute .Application.Selection = Answer2Val .Application.Selection.EndOf Fname = Format(Date, "dd/mm/yyyy") & ("_ANSWER_CHANGE_COMMISSION_") & unit2 & iRow & a & ".doc" Fname = Replace(Fname, "/", "") .SaveAs Filename:="K:\test\" & Fname .Close End With iRow = iRow + 1 a = a + 1 Loop Set olApp = Nothing Exit Sub End Sub 

 Sub output_excel_data_to_word_documents_ANSWER() Dim wsh1 As Worksheet Dim wsh2 As Worksheet Dim wdApp As Object Dim iRow As Long Dim ReferenceDoc As String Dim DocSubject As String Dim unit As String Dim Answer1 As String ''Dim NmrTicket As String 'variable not used! ''Dim RepType As String 'variable not used! Dim wDoc As Word.Document Dim Answer2 As String Dim Observation As String Dim Answer2Val As String Dim j As Integer Dim rep1 As String Dim val1 As String Dim unit2 As String Dim Fname As String Dim unitLast As String Dim a As Integer Dim Datecomision As Date iRow = 5 a = 1 With ThisWorkbook Set wsh1 = .Worksheets("comision") Set wsh2 = .Worksheets("Answer2s") End With Set wdApp = CreateObject("Word.Application") wdApp.Visible = True Do Until IsEmpty(wsh1.Cells(iRow, 1)) With wsh1 ReferenceDoc = .Cells(iRow, 1).Value 'ReferenceDoc = DateFeb unitLast = .Cells(iRow - 1, 2).Value unit = .Cells(iRow, 2).Value DocSubject = .Cells(iRow, 3).Value Answer1 = .Cells(iRow, 7).Value Observation = .Cells(iRow, 8).Value Answer2 = .Cells(iRow, 9).Value Datecomision = "03/11/2016" unit2 = Replace(unit, "/", "") unit2 = Replace(unit2, " ", "") End With ''compare value of answer2 to give the variable a longer text answer for the document j = 2 With wsh2 Do Until IsEmpty(.Cells(j, 1)) rep1 = .Cells(j, 1).Value val1 = .Cells(j, 2).Value If Answer2 = rep1 Then Answer2Val = val1 End If j = j + 1 Loop: End With Set wDoc = wdApp.Documents.Open("K:\ModlNE2.dotx", ReadOnly:=True) With wdApp .Selection.Find.Text = "<<unit>>" .Selection.Find.Execute .Selection = unit .Selection.EndOf .Selection.Find.Text = "<<Datecomision>>" .Selection.Find.Execute .Selection = Datecomision .Selection.EndOf .Selection.Find.Text = "<<ReferenceDoc>>" .Selection.Find.Execute .Selection = ReferenceDoc .Selection.EndOf .Selection.Find.Text = "<<DocSubject>>" .Selection.Find.Execute .Selection = DocSubject .Selection.EndOf .Selection.Find.Text = "<<Answer1>>" .Selection.Find.Execute .Selection = Answer1 .Selection.EndOf .Selection.Find.Text = "<<Answer2>>." .Selection.Find.Execute .Selection = Answer2Val .Selection.EndOf .Selection.TypeParagraph End With Fname = Format(Date, "ddmmyyyy") & ("_ANSWER_CHANGE_COMMISSION_") & unit2 & iRow & a & ".doc" wDoc.SaveAs Filename:="K:\test\" & Fname wDoc.Close iRow = iRow + 1 a = a + 1 Loop End Sub