我有一个excel文件，我需要输出到word文档，事情是我需要尽可能多的word文档，因为工作表中有行。
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>
实际代码采用单词模板文档，并使用值填充它，事情是：
创建每个文档而不是采用模板会更好吗？有没有办法用模板做到这一点？
这是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
答案 0 :(得分：0)
您的代码只会因使用selection而感到困惑，而是使用对象。我添加了两个对象变量来保存工作表。
试试这个：
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