2016-11-04 114 views
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模板文件,並用值填充它,事情是:

  1. 它不會輸出與文檔中一樣多的行(也許在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 

回答

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