'chuong trinh dien du lieu tu Excel vao Word
Sub sao_ke()
' khai bao bien
Dim Wapp As Word.Application
Dim Wdoc As Word.Document
Dim numOfRow, numOfColoumn, iRow, iColumn As Long
' Gan gia tri cho cac bien
Set Wapp = CreateObject("word.application")
Wapp.Visible = True
With ThisWorkbook.Sheets("Sao ke") ' Sheet1 la ten cua sheet
numOfRow = Excel.WorksheetFunction.CountA(.Columns(3)) - 1 ' so 3 la so cot bat ky, -1 la tru 1 dong tieu de
numOfColoumn = Excel.WorksheetFunction.CountA(.Rows(2)) ' So 2 la vi tri cua dong co chua tieu de
For iRow = 1 To 1 Step 1 ' 1 la dong dau, 10 la dong cuoi
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Sao ke.docx") 'sao ke la ten file goc
For iColumn = 1 To numOfColoumn Step 1
Wdoc.Content.Find.Execute _
Findtext:=.Cells(2, iColumn + 1), _
Replacewith:=.Cells(iRow + 2, iColumn + 1), _
Replace:=wdReplaceAll
Next
Wdoc.SaveAs2 FileName:=ThisWorkbook.Path & "\DAU RA\" & _
"In uy quyen tai khoan ca nhan " & .Cells(iRow + 2, 25) & "docx"
Wdoc.Close
Next
Wapp.Quit
Set Wdoc = Nothing
MsgBox "finished"
End With
End Sub
'chuong trinh dien du lieu tu Excel vao Word
Sub saoke_word()
' khai bao bien
Dim oWord As Object, oFileNew As Object
Set oWord = CreateObject("Word.Application")
Dim numOfRow, numOfColoumn, iRow, iColumn As Long
' Gan gia tri cho cac bien
Set Wapp = CreateObject("oWord .application")
Wapp.Visible = True
With ThisWorkbook.Sheets("Sao ke") ' Sheet1 la ten cua sheet
numOfRow = Excel.WorksheetFunction.CountA(.Columns(3)) - 1 ' so 3 la so cot bat ky, -1 la tru 1 dong tieu de
numOfColoumn = Excel.WorksheetFunction.CountA(.Rows(2)) ' So 2 la vi tri cua dong co chua tieu de
For iRow = 1 To 1 Step 1 ' 1 la dong dau, 10 la dong cuoi
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Sao ke.docx") 'sao ke la ten file goc
For iColumn = 1 To numOfColoumn Step 1
Wdoc.Content.Find.Execute _
Findtext:=.Cells(2, iColumn + 1), _
Replacewith:=.Cells(iRow + 2, iColumn + 1), _
Replace:=wdReplaceAll
Next
Wdoc.SaveAs2 FileName:=ThisWorkbook.Path & "\DAU RA\" & _
"In sao ke " & .Cells(iRow + 2, 12) & "docx"
Wdoc.Close
Next
Wapp.Quit
Set Wdoc = Nothing
MsgBox "finished"
End With
End Sub