2016-11-04 3 views
0

워드 문서로 출력해야하는 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"변수를 추가하여 고유 한 파일의 이름을 지정했습니다). ly)

템플릿을 가져 오는 대신 각 문서를 고유하게 만드는 것이 좋습니까? 템플릿으로이 작업을 수행 할 수있는 방법이 있습니까?

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의 사용에 의해 혼동됩니다 귀하의 코드는, 대신에 객체와 함께 작동 :

다음은 VBA 코드입니다. 워크 시트를 저장할 두 개의 개체 변수를 추가했습니다.

이 시도 :

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 
관련 문제