0
我有一個excel文件,我需要輸出到word文檔,事情是我需要儘可能多的word文檔,因爲有工作表中的行。excel數據輸出到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>
實際的代碼需要Word模板文件,並用值填充它,事情是:
- 它不會輸出與文檔中一樣多的行(也許在UNIT變量中存在衝突,這就是爲什麼我添加了「a」變量來命名該文件是唯一的ly)
是否更好地創建每個文件而不是採取模板?有沒有什麼方法可以用模板做到這一點?
下面是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