Tùy chọn
Liên kết bảng biểu Excel sang Word thông qua Access
- Liên kết bảng biểu Excel sang Word thông qua Access
-
RE: Liên kết bảng biểu Excel sang Word thông qua Access
vuthaiha90 > 17-02-17, 03:09 PM
(16-02-17, 09:35 PM)ongke0711 Đã viết: Có mấy điều cần hỏi thêm bạn.
- Số cột của table trong Word có cố định (như file HDTC mẫu) là 4 cột không hay thay đổi?
- Nếu nhiều cột hơn (8 cột như bạn có nói) thì làm sao dàn trang trong Word cho được?
- Nếu bạn tự xử lý số liệu để ra được Table hoặc Query có số cột cố định đúng như file word template thì có code cho nó.
Vâng, bản em đưa bác ấy là 4 cột (số cột này không cố định bác ạ) và từ xưa em đang tạm làm theo hướng là tự nhập dữ liệu vào access rồi truyền sang word (hiện tại thì mới làm được kiểu truyền từ excel vào table nhanh hơn chút), nhưng giờ nhiều kỳ hơn mà vẫn để 4 cột thế thì sẽ rất dài, dãn hết hợp đồng ra, giờ em định là trong file word đó không kẻ sẵn bảng nữa mà mình có thể tự kẻ bằng VBA được không, còn chuyện là vẫn được 8 cột mà bác, như này này. Còn nếu cố định 4 cột hay 8 cột thì nó lại khác, thì chương trình em giải quyết được, khó là nó sẽ thay đổi (tại mới phát sinh 1 trường hợp nhiều kỳ nên em chưa nghĩ ra được hướng giải quyết cho về sau chứ lần này tạm copy paste @@). -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
tranthanhan1962 > 18-02-17, 11:05 PM
CSDL access hoàn toàn có thể quản lý công việc của bạn. Bạn có thể tạo nhiều report với số cột khác nhau. Ở nút lệnh xem/in viết thêm code để kiểm tra số cột và mở đúng report có số cột tương ứng (ví dụ dữ liệu có 4 cột thì mở report 4 cột, 5 cột thì mở report 5 cột...) đồng thời thiết kế dọc hay ngang tùy theo sô cột cũng được.
Nếu chịu khó thiết kế thì report cũng sẽ đẹp như word chứ không tệ hơn đâu bạn
.
-
RE: Liên kết bảng biểu Excel sang Word thông qua Access
vuthaiha90 > 20-02-17, 05:57 PM
(18-02-17, 11:05 PM)tranthanhan1962 Đã viết: CSDL access hoàn toàn có thể quản lý công việc của bạn. Bạn có thể tạo nhiều report với số cột khác nhau. Ở nút lệnh xem/in viết thêm code để kiểm tra số cột và mở đúng report có số cột tương ứng (ví dụ dữ liệu có 4 cột thì mở report 4 cột, 5 cột thì mở report 5 cột...) đồng thời thiết kế dọc hay ngang tùy theo sô cột cũng được.
Nếu chịu khó thiết kế thì report cũng sẽ đẹp như word chứ không tệ hơn đâu bạn .
Dạ em xin cảm ơn bác, cho em hỏi code kiểm tra số cột thế nào ạ, bác có thể demo hộ em được không -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
ongke0711 > 20-02-17, 08:21 PM
(17-02-17, 03:09 PM)vuthaiha90 Đã viết: Vâng, bản em đưa bác ấy là 4 cột (số cột này không cố định bác ạ) và từ xưa em đang tạm làm theo hướng là tự nhập dữ liệu vào access rồi truyền sang word (hiện tại thì mới làm được kiểu truyền từ excel vào table nhanh hơn chút), nhưng giờ nhiều kỳ hơn mà vẫn để 4 cột thế thì sẽ rất dài, dãn hết hợp đồng ra, giờ em định là trong file word đó không kẻ sẵn bảng nữa mà mình có thể tự kẻ bằng VBA được không, còn chuyện là vẫn được 8 cột mà bác, như này này. Còn nếu cố định 4 cột hay 8 cột thì nó lại khác, thì chương trình em giải quyết được, khó là nó sẽ thay đổi (tại mới phát sinh 1 trường hợp nhiều kỳ nên em chưa nghĩ ra được hướng giải quyết cho về sau chứ lần này tạm copy paste @@).
Tôi demo cho bạn cách export Table Access (không cố định trước số cột và dòng) sang table định sẳn trong tài liệu Word.
- Giả định là bạn đã xử lý dữ liệu để ra được table cần export dữ liệu “T_PkytranoTC” như file bạn gửi.
- Trong file word cần import, bạn phải vẽ 1 table có 1 cột và 1 dòng tại vị trí cần import table Access.
- Nhớ số thứ tự vị trí của table này trong file word để đưa tham số vô hàm Access. (Table nào nằm trước tiên sẽ có giá trị = 1)
- Code hàm Export2DOC: Copy vào module
Mã PHP:Option Compare Database
[/font]
Option Explicit
Public Function Export2DOC(sWordFilePath As String, sQuery As String, tblNoInDoc As Byte)
Dim oWord As Object, oWordDoc As Object, oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database, rs As DAO.Recordset
Dim iCols As Integer, iRecCount As Integer, iFldCount As Integer, i As Integer, j As Integer
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = False 'Keep Word hidden until we are done with our manipulation
Set oWordDoc = oWord.Documents.Open(sWordFilePath)
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
Set oWordTbl = oWordDoc.Tables(tblNoInDoc) 'tblNoInDoc: Order No of table in document
'Them cot
With oWordDoc.Tables(tblNoInDoc)
.Select
Do Until .Columns.Count = iFldCount
.Columns.add
'.Columns.SetWidth = (7.6) / iFldCount
.Columns.AutoFit
Loop
End With
'Build our Header Row
For i = 0 To iFldCount - 1
If i Mod 2 = 1 Then
'oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name 'Get Field name from table Access
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=2")
Else
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=1")
End If
Next i
'Build our data rows
For i = 1 To iRecCount
oWordDoc.Tables(tblNoInDoc).Rows.add
For j = 0 To iFldCount - 1
If j Mod 2 = 1 Then
oWordTbl.Cell(i + 1, j + 1) = Format(Nz(rs.Fields(j).Value, ""), "$#,###")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 2
Else
oWordTbl.Cell(i + 1, j + 1) = Nz(rs.Fields(j).Value, "")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 1
End If
Next j
.MoveNext
Next i
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
'Format bold 1st row
With oWordDoc.Tables(tblNoInDoc).Rows(1).Range
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.Cells.VerticalAlignment = 1
End With
' oWordDoc.Close True, sFileName 'Save and close
'Close Word if is wasn't originally running
' If bWordOpened = False Then
' oWord.Quit
' End If
Error_Handler_Exit:
On Error Resume Next
oWord.Visible = True 'Make Word visible to the user
rs.Close
Set rs = Nothing
Set db = Nothing
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
[font=Tahoma]End Function
- Code cho nút lệnh Xuất sang Word:
Trong đó, Me.txtPath là đường dẫn file word cần xuất sang; "T_PkytranoTC" là table hoặc query dữ liệu để xuất, 1 là vị trí table cần xuất trong file word.Mã PHP:Private Sub cmdXuatWord_Click()
Call Export2DOC(Me.txtPath, "T_PkytranoTC", 1)
End Sub
![[Hình: 32885616721_d31d0615ff_z.jpg]](https://c1.staticflickr.com/3/2275/32885616721_d31d0615ff_z.jpg)
Link file demo: http://www.mediafire.com/file/1792aabwta...dTable.rar -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
tranthanhan1962 > 21-02-17, 12:08 AM
(20-02-17, 05:57 PM)vuthaiha90 Đã viết: Dạ em xin cảm ơn bác, cho em hỏi code kiểm tra số cột thế nào ạ, bác có thể demo hộ em được không
Trường hợp của bạn mình nghĩ dữ liệu các cột sẽ là number vì vậy mỗi cột bạn sẽ có tổng của cột đó, các cột có tổng bằng 0 sẽ bỏ
Ví dụ: Bảng có cột bắt buột là A, B, C, các cột có thể bỏ là 1,2,3. Bạn sẽ thiết kế một subform chứa tổng các cột nằm trên form và nút lệnh mở report.
Thiết kế report 1 có các cột A,B,C,1
Thiết kế report 2 có các cột A,B,C,1,2
Thiết kế report 3 có các cột A,B,C,1,2,3
Nếu tổng cột 2 và tổng cột 3 là 0 sẽ mở report 1
Nếu tổng cột 3 là 0 sẽ mở report 2
Nếu tổng ba cột có giá trị sẽ mở report 3
Mã:Private Sub MoReport_Click()
On Error GoTo Err_MoReport_Click
Dim stDocName As String
If tổng cột <>0 & tổng cột 2 =0 & tổng cột 3= 0 Then
stDocName = "Report 1"
Else
If tổng cột 1<>0 & tổng cột 2 <> 0 & tổng cột 3= 0 Then
stDocName = "Report 2"
Else
stDocName = "Report 3"
End If
End If
DoCmd.OpenReport stDocName, acPreview
Exit_MoReport_Click:
Exit Sub
Err_MoReport_Click:
MsgBox Err.Description
Resume Exit_MoReport_Click
End Sub
* Các tổng cột tham chiếu trên sub form -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
vuthaiha90 > 23-02-17, 05:47 PM
(20-02-17, 08:21 PM)ongke0711 Đã viết:
(17-02-17, 03:09 PM)vuthaiha90 Đã viết: Vâng, bản em đưa bác ấy là 4 cột (số cột này không cố định bác ạ) và từ xưa em đang tạm làm theo hướng là tự nhập dữ liệu vào access rồi truyền sang word (hiện tại thì mới làm được kiểu truyền từ excel vào table nhanh hơn chút), nhưng giờ nhiều kỳ hơn mà vẫn để 4 cột thế thì sẽ rất dài, dãn hết hợp đồng ra, giờ em định là trong file word đó không kẻ sẵn bảng nữa mà mình có thể tự kẻ bằng VBA được không, còn chuyện là vẫn được 8 cột mà bác, như này này. Còn nếu cố định 4 cột hay 8 cột thì nó lại khác, thì chương trình em giải quyết được, khó là nó sẽ thay đổi (tại mới phát sinh 1 trường hợp nhiều kỳ nên em chưa nghĩ ra được hướng giải quyết cho về sau chứ lần này tạm copy paste @@).
Tôi demo cho bạn cách export Table Access (không cố định trước số cột và dòng) sang table định sẳn trong tài liệu Word.
- Giả định là bạn đã xử lý dữ liệu để ra được table cần export dữ liệu “T_PkytranoTC” như file bạn gửi.
- Trong file word cần import, bạn phải vẽ 1 table có 1 cột và 1 dòng tại vị trí cần import table Access.
- Nhớ số thứ tự vị trí của table này trong file word để đưa tham số vô hàm Access. (Table nào nằm trước tiên sẽ có giá trị = 1)
- Code hàm Export2DOC: Copy vào module
Mã PHP:Option Compare Database
[/font]
Option Explicit
Public Function Export2DOC(sWordFilePath As String, sQuery As String, tblNoInDoc As Byte)
Dim oWord As Object, oWordDoc As Object, oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database, rs As DAO.Recordset
Dim iCols As Integer, iRecCount As Integer, iFldCount As Integer, i As Integer, j As Integer
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = False 'Keep Word hidden until we are done with our manipulation
Set oWordDoc = oWord.Documents.Open(sWordFilePath)
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
Set oWordTbl = oWordDoc.Tables(tblNoInDoc) 'tblNoInDoc: Order No of table in document
'Them cot
With oWordDoc.Tables(tblNoInDoc)
.Select
Do Until .Columns.Count = iFldCount
.Columns.add
'.Columns.SetWidth = (7.6) / iFldCount
.Columns.AutoFit
Loop
End With
'Build our Header Row
For i = 0 To iFldCount - 1
If i Mod 2 = 1 Then
'oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name 'Get Field name from table Access
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=2")
Else
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=1")
End If
Next i
'Build our data rows
For i = 1 To iRecCount
oWordDoc.Tables(tblNoInDoc).Rows.add
For j = 0 To iFldCount - 1
If j Mod 2 = 1 Then
oWordTbl.Cell(i + 1, j + 1) = Format(Nz(rs.Fields(j).Value, ""), "$#,###")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 2
Else
oWordTbl.Cell(i + 1, j + 1) = Nz(rs.Fields(j).Value, "")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 1
End If
Next j
.MoveNext
Next i
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
'Format bold 1st row
With oWordDoc.Tables(tblNoInDoc).Rows(1).Range
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.Cells.VerticalAlignment = 1
End With
' oWordDoc.Close True, sFileName 'Save and close
'Close Word if is wasn't originally running
' If bWordOpened = False Then
' oWord.Quit
' End If
Error_Handler_Exit:
On Error Resume Next
oWord.Visible = True 'Make Word visible to the user
rs.Close
Set rs = Nothing
Set db = Nothing
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
[font=Tahoma]End Function
- Code cho nút lệnh Xuất sang Word:
Trong đó, Me.txtPath là đường dẫn file word cần xuất sang; "T_PkytranoTC" là table hoặc query dữ liệu để xuất, 1 là vị trí table cần xuất trong file word.Mã PHP:Private Sub cmdXuatWord_Click()
Call Export2DOC(Me.txtPath, "T_PkytranoTC", 1)
End Sub
Link file demo: http://www.mediafire.com/file/1792aabwta...dTable.rar
Mấy hôm nay em ngâm cứu code của bác và của mọi người để tổng hợp vào chương trình của em, cũng gần chuẩn rồi. Em xin trình bày thứ tự các bước làm trong chương trình của em:
-Nhập liệu các thông tin khách hàng và Quyền sử dụng đất (Dùng Form để nhập liệu vào Table)
-Có 1 file Excel bên ngoài làm phân kỳ trả nợ cho nhanh, Phần "Form chọn file Excel" đó để Import vào Table của access.
-Có 2 Folder "Word" và "Preview", Word để chứa file nguồn (bao gồm các điều khoản quy định ... các thành phần bất di bất dịch nói chung trong Hợp đồng), Preview để chứa file đích đã nhập hết thông tin thay đổi (từ các Table vào, như thông tin khách hàng, thông tin Quyền sử dụng đất...) để in. Trong đó, Code VBA sử dụng "FormField" để truyền thông tin thay đổi vào chỗ trống.
-Bác "ongke0711" đã cho em code để truyền table access sang table word (nhưng phải có file Word sẵn rồi), mà chương trình của em thì chưa đến dòng cuối cùng Save as file name thì chưa có file Word mà truyền table sang table như bác Demo hộ em (Hiện tại thì em đang hiểu là phải save tạm 1 file như là "Hopdong_tam" rồi từ file Word "Hopdong_tam" ấy mới dùng code của bác "ongke0711" để truyền table nhưng bị dính lỗi là file ở chế độ "read only" nên không save as filename được), vậy cho em hỏi thêm bác và mọi người xem file của em đây, sửa lại hộ em hoặc hướng dẫn để em hoàn thiện nốt chương trình ạ. Em cảm ơn mọi người! -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
ongke0711 > 24-02-17, 12:46 AM
(23-02-17, 05:47 PM)vuthaiha90 Đã viết: Mấy hôm nay em ngâm cứu code của bác và của mọi người để tổng hợp vào chương trình của em, cũng gần chuẩn rồi. Em xin trình bày thứ tự các bước làm trong chương trình của em:
-Nhập liệu các thông tin khách hàng và Quyền sử dụng đất (Dùng Form để nhập liệu vào Table)
-Có 1 file Excel bên ngoài làm phân kỳ trả nợ cho nhanh, Phần "Form chọn file Excel" đó để Import vào Table của access.
-Có 2 Folder "Word" và "Preview", Word để chứa file nguồn (bao gồm các điều khoản quy định ... các thành phần bất di bất dịch nói chung trong Hợp đồng), Preview để chứa file đích đã nhập hết thông tin thay đổi (từ các Table vào, như thông tin khách hàng, thông tin Quyền sử dụng đất...) để in. Trong đó, Code VBA sử dụng "FormField" để truyền thông tin thay đổi vào chỗ trống.
-Bác "ongke0711" đã cho em code để truyền table access sang table word (nhưng phải có file Word sẵn rồi), mà chương trình của em thì chưa đến dòng cuối cùng Save as file name thì chưa có file Word mà truyền table sang table như bác Demo hộ em (Hiện tại thì em đang hiểu là phải save tạm 1 file như là "Hopdong_tam" rồi từ file Word "Hopdong_tam" ấy mới dùng code của bác "ongke0711" để truyền table nhưng bị dính lỗi là file ở chế độ "read only" nên không save as filename được), vậy cho em hỏi thêm bác và mọi người xem file của em đây, sửa lại hộ em hoặc hướng dẫn để em hoàn thiện nốt chương trình ạ. Em cảm ơn mọi người!
Cái này thì cũng không khó. Cái hàm "Export2DOC" dùng cho trường hợp phải tự tạo file Doc (lấy từ file mẫu) để export dữ liệu. Trong trường hợp của bạn, đã có đoạn code mở file Doc, export dữ liệu cho các Field trong hợp đồng rồi thì bạn lược bỏ các đoạn code trong hàm liên quan đến tạo file word .doc. Đổi tên các biến lại cho giống phần đầu bạn đã khai báo.
Ví dụ như: Set oWord = GetObject("Word.Application")
...
Tôi có sửa phần code xuất ra file word của bạn như bên dưới (chủ yếu phần export sang table), còn phần code đầu của bạn tôi giữa nguyên.
Mã PHP:Private Sub HDTDTC_Click()
If IsNull(Me.cmbSep) Then
MsgBoxUni ("Xin ch" & ChrW(7885) & "n tên S" & ChrW(7871) & "p")
Me.cmbSep.SetFocus
Exit Sub
End If
If IsNull(Me.SoHDTDTC) Then
MsgBoxUni ("Xin " & ChrW(273) & "i" & ChrW(7873) & "n S" & ChrW(7889) & " H" & ChrW(7907) & "p " & ChrW(272) & ChrW(7891) & "ng")
Me.SoHDTDTC.SetFocus
Exit Sub
End If
Me.RecordSource = "T_Gioitinh"
Me.Requery
Me.RecordSource = "T_infovayTC"
Me.Requery
Me.RecordSource = "T_KH2"
Me.Requery
Me.RecordSource = "T_PkytranoTC"
Me.Requery
Me.RecordSource = "T_QSDD"
Me.Requery
Me.RecordSource = "T_Sep"
Me.Requery
Me.RecordSource = "T_SoHonghayDo"
Me.Requery
Me.RecordSource = "T_TenCB"
Me.Requery
Me.RecordSource = "T_Thechapcaigi"
Me.Requery
Me.RecordSource = "T_TSGLTD"
Me.Requery
Me.RecordSource = "T_TTTDTC"
Me.Requery
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim i As Long
Dim oApp As Object
Dim Doc As Object
Dim strDocName As String
Dim tblNoInDoc As Byte
Dim oWordTbl As Object
temp = """"
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
strDocName = """" & CurrentProject.Path & "\Word\TC" & "\HDTDTC.doc" & """"
Set Doc = oApp.Documents.add(strDocName)
Doc.FormFields("SoHDTDTC").Result = Me.SoHDTDTC
Doc.FormFields("SoKWTDTC").Result = IIf(Me.SoKWTDTC <> "" Or Me.SoKWTDTC <> 0, Me.SoKWTDTC, "....................")
Doc.FormFields("TheloaivayTC").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") > 12, "Trung h" & ChrW(7841) & "n", "Ng" & ChrW(7855) & "n h" & ChrW(7841) & "n")
Doc.FormFields("DonvayTCngaychu").Result = Me.DonvayTCngaychu
Doc.FormFields("Ngaythangnam2").Result = Me.HDTDngayTCchu
Doc.FormFields("TenSep").Result = Me.cmbSep
Doc.FormFields("Chucvu").Result = Me.Chucvu
Doc.FormFields("SoUyQuyen").Result = IIf(Me.SoUyQuyen.Value <> "", Me.SoUyQuyen & "/GUQ", "..........")
Doc.FormFields("NgayUyQuyen").Result = IIf(Me.NgayUyQuyen.Value <> "", Me.NgayUyQuyen, "....../....../201....")
Doc.FormFields("Bendivay").Result = DLookup("Gioitinhdd", "T_KH2") & " " & DLookup("Nguoidaidien", "T_KH2") & IIf(DLookup("Vohoacchong", "T_KH2") <> "", " v" & ChrW(224) & " " & DLookup("Gioitinhconlai", "T_KH2") & " " & DLookup("Vohoacchong", "T_KH2"), ".")
Doc.FormFields("DiachiHK").Result = DLookup("DiachiHK", "T_KH2")
Doc.FormFields("Dienthoai").Result = IIf(DLookup("Dienthoaidd", "T_KH2") <> "", DLookup("Dienthoaidd", "T_KH2"), "................")
Doc.FormFields("DKKDso").Result = IIf(DLookup("DKKDso", "T_KH2") <> "", DLookup("DKKDso", "T_KH2"), ".........")
Doc.FormFields("NoicapDKKD").Result = IIf(DLookup("NoicapDKKD", "T_KH2") <> "", DLookup("NoicapDKKD", "T_KH2"), ".........")
Doc.FormFields("DKKDcapngay").Result = IIf(DLookup("DKKDcapngay", "T_KH2") <> "", DLookup("DKKDcapngay", "T_KH2"), ".........")
Doc.FormFields("Gioitinhdd").Result = DLookup("Gioitinhdd", "T_KH2") & " "
Doc.FormFields("Nguoidaidien").Result = DLookup("Nguoidaidien", "T_KH2")
Doc.FormFields("CMTdd").Result = DLookup("CMTdd", "T_KH2")
Doc.FormFields("NgcapCMTdd").Result = DLookup("NgcapCMTdd", "T_KH2")
Doc.FormFields("NoicapCMTdd").Result = DLookup("NoicapCMTdd", "T_KH2")
Doc.FormFields("SotienvayTC").Result = Format(DLookup("SotienvayTC", "T_infovayTC"), "#.##0")
Doc.FormFields("SotienvayTCbangchu").Result = Me.SotienvayTCbangchu
Doc.FormFields("ThoihanvayTC").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") < 10, "0" & DLookup("ThoihanvayTC", "T_infovayTC"), DLookup("ThoihanvayTC", "T_infovayTC"))
Doc.FormFields("MucdichvayTC").Result = DLookup("MucdichvayTC", "T_infovayTC")
Doc.FormFields("ThechapTScuabenB").Result = Me.Thechapcaigi
Doc.FormFields("ThechapTScuabenB2").Result = IIf(DLookup("Ddthechap", "T_KH2") <> "", "", vbCr & vbTab & "- " & Me.QSDD1 & IIf(DLookup("VPDKso1", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap1", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso1", "T_QSDD") & " ngày " & DLookup("VPDKngay1", "T_QSDD") & ", mang tên " & DLookup("Mangten1", "T_QSDD"), ", mang tên " & DLookup("Mangten1", "T_QSDD")))
If DLookup("Dientichdat2", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet2").Result = ""
Else
Doc.FormFields("TCbenBchitiet2").Result = vbCr & vbTab & "- " & Me.QSDD2 & IIf(DLookup("VPDKso2", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap2", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso2", "T_QSDD") & " ngày " & DLookup("VPDKngay2", "T_QSDD") & ", mang tên " & DLookup("Mangten2", "T_QSDD"), ", mang tên " & DLookup("Mangten2", "T_QSDD"))
End If
End If
If DLookup("Dientichdat3", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet3").Result = ""
Else
Doc.FormFields("TCbenBchitiet3").Result = vbCr & vbTab & "- " & Me.QSDD3 & IIf(DLookup("VPDKso3", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap3", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso3", "T_QSDD") & " ngày " & DLookup("VPDKngay3", "T_QSDD") & ", mang tên " & DLookup("Mangten3", "T_QSDD"), ", mang tên " & DLookup("Mangten3", "T_QSDD"))
End If
End If
If DLookup("Dientichdat4", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet4").Result = ""
Else
Doc.FormFields("TCbenBchitiet4").Result = vbCr & vbTab & "- " & Me.QSDD4 & IIf(DLookup("VPDKso4", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap4", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso4", "T_QSDD") & " ngày " & DLookup("VPDKngay4", "T_QSDD") & ", mang tên " & DLookup("Mangten4", "T_QSDD"), ", mang tên " & DLookup("Mangten4", "T_QSDD"))
End If
End If
If DLookup("Dientichdat5", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet5").Result = ""
Else
Doc.FormFields("TCbenBchitiet5").Result = vbCr & vbTab & "- " & Me.QSDD5 & IIf(DLookup("VPDKso5", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap5", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso5", "T_QSDD") & " ngày " & DLookup("VPDKngay5", "T_QSDD") & ", mang tên " & DLookup("Mangten5", "T_QSDD"), ", mang tên " & DLookup("Mangten5", "T_QSDD"))
End If
End If
Doc.FormFields("ThechapTScuabenthu3").Result = Me.Thechapcaigi2 & IIf(DLookup("Ddthechap", "T_KH2") <> "", vbCr & vbTab & "- " & Me.QSDD1 & IIf(DLookup("VPDKso1", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap1", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso1", "T_QSDD") & " ngày " & DLookup("VPDKngay1", "T_QSDD") & ", mang tên " & DLookup("Mangten1", "T_QSDD"), ", mang tên " & DLookup("Mangten1", "T_QSDD")), "")
If DLookup("Dientichdat2", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet2").Result = vbCr & vbTab & "- " & Me.QSDD2 & IIf(DLookup("VPDKso2", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap2", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso2", "T_QSDD") & " ngày " & DLookup("VPDKngay2", "T_QSDD") & ", mang tên " & DLookup("Mangten2", "T_QSDD"), ", mang tên " & DLookup("Mangten2", "T_QSDD"))
End If
If DLookup("Dientichdat3", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet3").Result = vbCr & vbTab & "- " & Me.QSDD3 & IIf(DLookup("VPDKso3", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap3", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso3", "T_QSDD") & " ngày " & DLookup("VPDKngay3", "T_QSDD") & ", mang tên " & DLookup("Mangten3", "T_QSDD"), ", mang tên " & DLookup("Mangten3", "T_QSDD"))
End If
If DLookup("Dientichdat4", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet4").Result = vbCr & vbTab & "- " & Me.QSDD4 & IIf(DLookup("VPDKso4", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap4", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso4", "T_QSDD") & " ngày " & DLookup("VPDKngay4", "T_QSDD") & ", mang tên " & DLookup("Mangten4", "T_QSDD"), ", mang tên " & DLookup("Mangten4", "T_QSDD"))
End If
If DLookup("Dientichdat5", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet5").Result = vbCr & vbTab & "- " & Me.QSDD5 & IIf(DLookup("VPDKso5", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap5", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso5", "T_QSDD") & " ngày " & DLookup("VPDKngay5", "T_QSDD") & ", mang tên " & DLookup("Mangten5", "T_QSDD"), ", mang tên " & DLookup("Mangten5", "T_QSDD"))
End If
Doc.FormFields("TongGiatriTS").Result = Format(Me.TongGiatri5TS, "#.##0")
Doc.FormFields("TongGiatriTSbangchu").Result = Me.TongGiatri5TSchu
Doc.FormFields("SoHDTDTC2").Result = Me.SoHDTDTC
Doc.FormFields("SoKWTDTC2").Result = IIf(Me.SoKWTDTC <> "" Or Me.SoKWTDTC <> 0, Me.SoKWTDTC, "...............")
Doc.FormFields("Ngayvay").Result = DLookup("HDTDngayTC", "T_infovayTC") 'Me.Ngayvay
Doc.FormFields("SotienvayTC2").Result = Format(DLookup("SotienvayTC", "T_infovayTC"), "#.##0")
Doc.FormFields("ThoihanvayTC2").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") < 10, "0" & DLookup("ThoihanvayTC", "T_infovayTC"), DLookup("ThoihanvayTC", "T_infovayTC"))
Doc.FormFields("Ngayvay2").Result = Me.HDTDngayTC 'Me.Ngayvay
Doc.FormFields("SotienvayTC3").Result = Format(DLookup("Nhannolannay", "T_infovayTC"), "#,##0")
Doc.FormFields("Laisuat").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") <= 12, "0,79", "0,85")
Doc.FormFields("SotienvayTC4").Result = Format(DLookup("Nhannolannay", "T_infovayTC"), "#,##0")
Doc.FormFields("SokytraTC").Result = IIf(DLookup("SokytraTC", "T_infovayTC") < 10, "0" & DLookup("SokytraTC", "T_infovayTC"), DLookup("SokytraTC", "T_infovayTC"))
'oApp.ActiveDocument.SaveAs Filename:="""" & CurrentProject.Path & "\Preview\TC" & "\" & "HDTDTC_tam.doc" & """"
'Set oApp = Nothing'
'oApp.Close'
'---------------------------------------------------------'
'EXPORT TABLE VAO FILE DOC'
'---------------------------------------------------------'
If DLookup("SokytraTC", "T_infovayTC") > 1 Then
'Mo table can export qua file Doc'
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tempFromExcel", dbOpenSnapshot)
With rst
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query'
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query'
tblNoInDoc = 1 'So thu tu cua table trong file Doc'
Set oWordTbl = Doc.Tables(tblNoInDoc)
'Them cot'
With Doc.Tables(tblNoInDoc)
.Select
Do Until .Columns.Count = iFldCount
.Columns.add
.Columns.AutoFit
Loop
End With
'Build our Header Row'
For i = 0 To iFldCount - 1
If i Mod 2 = 1 Then 'Xac dinh cot chan de dat ten cot giong nhau'
'oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name 'Get Field name from table Access'
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=2")
Else
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=1")
End If
Next i
'Build our data rows'
For i = 1 To iRecCount
Doc.Tables(tblNoInDoc).Rows.add
For j = 0 To iFldCount - 1
If j Mod 2 = 1 Then
oWordTbl.Cell(i + 1, j + 1) = Format(Nz(rst.Fields(j).Value, ""), "#,###")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 2
Else
oWordTbl.Cell(i + 1, j + 1) = Nz(rst.Fields(j).Value, "")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 1
End If
Next j
.MoveNext
Next i
Else
MsgBox "Khong co du lieu Ky han tra no.", vbCritical + vbOKOnly, "Thông báo"
GoTo Error_Handler_Exit
End If
End With
'Format bold 1st row'
With Doc.Tables(tblNoInDoc).Rows(1).Range
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.Cells.VerticalAlignment = 1
End With
Error_Handler_Exit:
On Error Resume Next
oApp.Visible = True 'Make Word visible to the user'
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set oWordTbl = Nothing
Set Doc = Nothing
Set oApp = Nothing
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End If
oApp.ActiveDocument.SaveAs Filename:="""" & CurrentProject.Path & "\Preview\TC" & "\" & "HDTDTC" & "_" & DLookup("Nguoidaidien", "T_KH2") & "_" & Me.DonvayTCngaychu & ".doc" & """"
Set oApp = Nothing
End Sub -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
vuthaiha90 > 24-02-17, 09:22 AM
(24-02-17, 12:46 AM)ongke0711 Đã viết:
(23-02-17, 05:47 PM)vuthaiha90 Đã viết: Mấy hôm nay em ngâm cứu code của bác và của mọi người để tổng hợp vào chương trình của em, cũng gần chuẩn rồi. Em xin trình bày thứ tự các bước làm trong chương trình của em:
-Nhập liệu các thông tin khách hàng và Quyền sử dụng đất (Dùng Form để nhập liệu vào Table)
-Có 1 file Excel bên ngoài làm phân kỳ trả nợ cho nhanh, Phần "Form chọn file Excel" đó để Import vào Table của access.
-Có 2 Folder "Word" và "Preview", Word để chứa file nguồn (bao gồm các điều khoản quy định ... các thành phần bất di bất dịch nói chung trong Hợp đồng), Preview để chứa file đích đã nhập hết thông tin thay đổi (từ các Table vào, như thông tin khách hàng, thông tin Quyền sử dụng đất...) để in. Trong đó, Code VBA sử dụng "FormField" để truyền thông tin thay đổi vào chỗ trống.
-Bác "ongke0711" đã cho em code để truyền table access sang table word (nhưng phải có file Word sẵn rồi), mà chương trình của em thì chưa đến dòng cuối cùng Save as file name thì chưa có file Word mà truyền table sang table như bác Demo hộ em (Hiện tại thì em đang hiểu là phải save tạm 1 file như là "Hopdong_tam" rồi từ file Word "Hopdong_tam" ấy mới dùng code của bác "ongke0711" để truyền table nhưng bị dính lỗi là file ở chế độ "read only" nên không save as filename được), vậy cho em hỏi thêm bác và mọi người xem file của em đây, sửa lại hộ em hoặc hướng dẫn để em hoàn thiện nốt chương trình ạ. Em cảm ơn mọi người!
Cái này thì cũng không khó. Cái hàm "Export2DOC" dùng cho trường hợp phải tự tạo file Doc (lấy từ file mẫu) để export dữ liệu. Trong trường hợp của bạn, đã có đoạn code mở file Doc, export dữ liệu cho các Field trong hợp đồng rồi thì bạn lược bỏ các đoạn code trong hàm liên quan đến tạo file word .doc. Đổi tên các biến lại cho giống phần đầu bạn đã khai báo.
Ví dụ như: Set oWord = GetObject("Word.Application")
...
Tôi có sửa phần code xuất ra file word của bạn như bên dưới (chủ yếu phần export sang table), còn phần code đầu của bạn tôi giữa nguyên.
Mã PHP:Private Sub HDTDTC_Click()
If IsNull(Me.cmbSep) Then
MsgBoxUni ("Xin ch" & ChrW(7885) & "n tên S" & ChrW(7871) & "p")
Me.cmbSep.SetFocus
Exit Sub
End If
If IsNull(Me.SoHDTDTC) Then
MsgBoxUni ("Xin " & ChrW(273) & "i" & ChrW(7873) & "n S" & ChrW(7889) & " H" & ChrW(7907) & "p " & ChrW(272) & ChrW(7891) & "ng")
Me.SoHDTDTC.SetFocus
Exit Sub
End If
Me.RecordSource = "T_Gioitinh"
Me.Requery
Me.RecordSource = "T_infovayTC"
Me.Requery
Me.RecordSource = "T_KH2"
Me.Requery
Me.RecordSource = "T_PkytranoTC"
Me.Requery
Me.RecordSource = "T_QSDD"
Me.Requery
Me.RecordSource = "T_Sep"
Me.Requery
Me.RecordSource = "T_SoHonghayDo"
Me.Requery
Me.RecordSource = "T_TenCB"
Me.Requery
Me.RecordSource = "T_Thechapcaigi"
Me.Requery
Me.RecordSource = "T_TSGLTD"
Me.Requery
Me.RecordSource = "T_TTTDTC"
Me.Requery
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim i As Long
Dim oApp As Object
Dim Doc As Object
Dim strDocName As String
Dim tblNoInDoc As Byte
Dim oWordTbl As Object
temp = """"
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
strDocName = """" & CurrentProject.Path & "\Word\TC" & "\HDTDTC.doc" & """"
Set Doc = oApp.Documents.add(strDocName)
Doc.FormFields("SoHDTDTC").Result = Me.SoHDTDTC
Doc.FormFields("SoKWTDTC").Result = IIf(Me.SoKWTDTC <> "" Or Me.SoKWTDTC <> 0, Me.SoKWTDTC, "....................")
Doc.FormFields("TheloaivayTC").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") > 12, "Trung h" & ChrW(7841) & "n", "Ng" & ChrW(7855) & "n h" & ChrW(7841) & "n")
Doc.FormFields("DonvayTCngaychu").Result = Me.DonvayTCngaychu
Doc.FormFields("Ngaythangnam2").Result = Me.HDTDngayTCchu
Doc.FormFields("TenSep").Result = Me.cmbSep
Doc.FormFields("Chucvu").Result = Me.Chucvu
Doc.FormFields("SoUyQuyen").Result = IIf(Me.SoUyQuyen.Value <> "", Me.SoUyQuyen & "/GUQ", "..........")
Doc.FormFields("NgayUyQuyen").Result = IIf(Me.NgayUyQuyen.Value <> "", Me.NgayUyQuyen, "....../....../201....")
Doc.FormFields("Bendivay").Result = DLookup("Gioitinhdd", "T_KH2") & " " & DLookup("Nguoidaidien", "T_KH2") & IIf(DLookup("Vohoacchong", "T_KH2") <> "", " v" & ChrW(224) & " " & DLookup("Gioitinhconlai", "T_KH2") & " " & DLookup("Vohoacchong", "T_KH2"), ".")
Doc.FormFields("DiachiHK").Result = DLookup("DiachiHK", "T_KH2")
Doc.FormFields("Dienthoai").Result = IIf(DLookup("Dienthoaidd", "T_KH2") <> "", DLookup("Dienthoaidd", "T_KH2"), "................")
Doc.FormFields("DKKDso").Result = IIf(DLookup("DKKDso", "T_KH2") <> "", DLookup("DKKDso", "T_KH2"), ".........")
Doc.FormFields("NoicapDKKD").Result = IIf(DLookup("NoicapDKKD", "T_KH2") <> "", DLookup("NoicapDKKD", "T_KH2"), ".........")
Doc.FormFields("DKKDcapngay").Result = IIf(DLookup("DKKDcapngay", "T_KH2") <> "", DLookup("DKKDcapngay", "T_KH2"), ".........")
Doc.FormFields("Gioitinhdd").Result = DLookup("Gioitinhdd", "T_KH2") & " "
Doc.FormFields("Nguoidaidien").Result = DLookup("Nguoidaidien", "T_KH2")
Doc.FormFields("CMTdd").Result = DLookup("CMTdd", "T_KH2")
Doc.FormFields("NgcapCMTdd").Result = DLookup("NgcapCMTdd", "T_KH2")
Doc.FormFields("NoicapCMTdd").Result = DLookup("NoicapCMTdd", "T_KH2")
Doc.FormFields("SotienvayTC").Result = Format(DLookup("SotienvayTC", "T_infovayTC"), "#.##0")
Doc.FormFields("SotienvayTCbangchu").Result = Me.SotienvayTCbangchu
Doc.FormFields("ThoihanvayTC").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") < 10, "0" & DLookup("ThoihanvayTC", "T_infovayTC"), DLookup("ThoihanvayTC", "T_infovayTC"))
Doc.FormFields("MucdichvayTC").Result = DLookup("MucdichvayTC", "T_infovayTC")
Doc.FormFields("ThechapTScuabenB").Result = Me.Thechapcaigi
Doc.FormFields("ThechapTScuabenB2").Result = IIf(DLookup("Ddthechap", "T_KH2") <> "", "", vbCr & vbTab & "- " & Me.QSDD1 & IIf(DLookup("VPDKso1", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap1", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso1", "T_QSDD") & " ngày " & DLookup("VPDKngay1", "T_QSDD") & ", mang tên " & DLookup("Mangten1", "T_QSDD"), ", mang tên " & DLookup("Mangten1", "T_QSDD")))
If DLookup("Dientichdat2", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet2").Result = ""
Else
Doc.FormFields("TCbenBchitiet2").Result = vbCr & vbTab & "- " & Me.QSDD2 & IIf(DLookup("VPDKso2", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap2", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso2", "T_QSDD") & " ngày " & DLookup("VPDKngay2", "T_QSDD") & ", mang tên " & DLookup("Mangten2", "T_QSDD"), ", mang tên " & DLookup("Mangten2", "T_QSDD"))
End If
End If
If DLookup("Dientichdat3", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet3").Result = ""
Else
Doc.FormFields("TCbenBchitiet3").Result = vbCr & vbTab & "- " & Me.QSDD3 & IIf(DLookup("VPDKso3", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap3", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso3", "T_QSDD") & " ngày " & DLookup("VPDKngay3", "T_QSDD") & ", mang tên " & DLookup("Mangten3", "T_QSDD"), ", mang tên " & DLookup("Mangten3", "T_QSDD"))
End If
End If
If DLookup("Dientichdat4", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet4").Result = ""
Else
Doc.FormFields("TCbenBchitiet4").Result = vbCr & vbTab & "- " & Me.QSDD4 & IIf(DLookup("VPDKso4", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap4", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso4", "T_QSDD") & " ngày " & DLookup("VPDKngay4", "T_QSDD") & ", mang tên " & DLookup("Mangten4", "T_QSDD"), ", mang tên " & DLookup("Mangten4", "T_QSDD"))
End If
End If
If DLookup("Dientichdat5", "T_QSDD") <> "" Then
If DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenBchitiet5").Result = ""
Else
Doc.FormFields("TCbenBchitiet5").Result = vbCr & vbTab & "- " & Me.QSDD5 & IIf(DLookup("VPDKso5", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap5", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso5", "T_QSDD") & " ngày " & DLookup("VPDKngay5", "T_QSDD") & ", mang tên " & DLookup("Mangten5", "T_QSDD"), ", mang tên " & DLookup("Mangten5", "T_QSDD"))
End If
End If
Doc.FormFields("ThechapTScuabenthu3").Result = Me.Thechapcaigi2 & IIf(DLookup("Ddthechap", "T_KH2") <> "", vbCr & vbTab & "- " & Me.QSDD1 & IIf(DLookup("VPDKso1", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap1", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso1", "T_QSDD") & " ngày " & DLookup("VPDKngay1", "T_QSDD") & ", mang tên " & DLookup("Mangten1", "T_QSDD"), ", mang tên " & DLookup("Mangten1", "T_QSDD")), "")
If DLookup("Dientichdat2", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet2").Result = vbCr & vbTab & "- " & Me.QSDD2 & IIf(DLookup("VPDKso2", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap2", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso2", "T_QSDD") & " ngày " & DLookup("VPDKngay2", "T_QSDD") & ", mang tên " & DLookup("Mangten2", "T_QSDD"), ", mang tên " & DLookup("Mangten2", "T_QSDD"))
End If
If DLookup("Dientichdat3", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet3").Result = vbCr & vbTab & "- " & Me.QSDD3 & IIf(DLookup("VPDKso3", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap3", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso3", "T_QSDD") & " ngày " & DLookup("VPDKngay3", "T_QSDD") & ", mang tên " & DLookup("Mangten3", "T_QSDD"), ", mang tên " & DLookup("Mangten3", "T_QSDD"))
End If
If DLookup("Dientichdat4", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet4").Result = vbCr & vbTab & "- " & Me.QSDD4 & IIf(DLookup("VPDKso4", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap4", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso4", "T_QSDD") & " ngày " & DLookup("VPDKngay4", "T_QSDD") & ", mang tên " & DLookup("Mangten4", "T_QSDD"), ", mang tên " & DLookup("Mangten4", "T_QSDD"))
End If
If DLookup("Dientichdat5", "T_QSDD") <> "" And DLookup("Ddthechap", "T_KH2") <> "" Then
Doc.FormFields("TCbenthu3chitiet5").Result = vbCr & vbTab & "- " & Me.QSDD5 & IIf(DLookup("VPDKso5", "T_QSDD") <> "", ". V" & ChrW(259) & "n phòng " & ChrW(272) & "K QSD" & ChrW(272) & " " & DLookup("Coquancap5", "T_QSDD") & " thay " & ChrW(273) & ChrW(7893) & "i ND c" & ChrW(417) & " s" & ChrW(7903) & " pháp lý s" & ChrW(7889) & " " & DLookup("VPDKso5", "T_QSDD") & " ngày " & DLookup("VPDKngay5", "T_QSDD") & ", mang tên " & DLookup("Mangten5", "T_QSDD"), ", mang tên " & DLookup("Mangten5", "T_QSDD"))
End If
Doc.FormFields("TongGiatriTS").Result = Format(Me.TongGiatri5TS, "#.##0")
Doc.FormFields("TongGiatriTSbangchu").Result = Me.TongGiatri5TSchu
Doc.FormFields("SoHDTDTC2").Result = Me.SoHDTDTC
Doc.FormFields("SoKWTDTC2").Result = IIf(Me.SoKWTDTC <> "" Or Me.SoKWTDTC <> 0, Me.SoKWTDTC, "...............")
Doc.FormFields("Ngayvay").Result = DLookup("HDTDngayTC", "T_infovayTC") 'Me.Ngayvay
Doc.FormFields("SotienvayTC2").Result = Format(DLookup("SotienvayTC", "T_infovayTC"), "#.##0")
Doc.FormFields("ThoihanvayTC2").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") < 10, "0" & DLookup("ThoihanvayTC", "T_infovayTC"), DLookup("ThoihanvayTC", "T_infovayTC"))
Doc.FormFields("Ngayvay2").Result = Me.HDTDngayTC 'Me.Ngayvay
Doc.FormFields("SotienvayTC3").Result = Format(DLookup("Nhannolannay", "T_infovayTC"), "#,##0")
Doc.FormFields("Laisuat").Result = IIf(DLookup("ThoihanvayTC", "T_infovayTC") <= 12, "0,79", "0,85")
Doc.FormFields("SotienvayTC4").Result = Format(DLookup("Nhannolannay", "T_infovayTC"), "#,##0")
Doc.FormFields("SokytraTC").Result = IIf(DLookup("SokytraTC", "T_infovayTC") < 10, "0" & DLookup("SokytraTC", "T_infovayTC"), DLookup("SokytraTC", "T_infovayTC"))
'oApp.ActiveDocument.SaveAs Filename:="""" & CurrentProject.Path & "\Preview\TC" & "\" & "HDTDTC_tam.doc" & """"
'Set oApp = Nothing'
'oApp.Close'
'---------------------------------------------------------'
'EXPORT TABLE VAO FILE DOC'
'---------------------------------------------------------'
If DLookup("SokytraTC", "T_infovayTC") > 1 Then
'Mo table can export qua file Doc'
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tempFromExcel", dbOpenSnapshot)
With rst
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query'
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query'
tblNoInDoc = 1 'So thu tu cua table trong file Doc'
Set oWordTbl = Doc.Tables(tblNoInDoc)
'Them cot'
With Doc.Tables(tblNoInDoc)
.Select
Do Until .Columns.Count = iFldCount
.Columns.add
.Columns.AutoFit
Loop
End With
'Build our Header Row'
For i = 0 To iFldCount - 1
If i Mod 2 = 1 Then 'Xac dinh cot chan de dat ten cot giong nhau'
'oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name 'Get Field name from table Access'
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=2")
Else
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=1")
End If
Next i
'Build our data rows'
For i = 1 To iRecCount
Doc.Tables(tblNoInDoc).Rows.add
For j = 0 To iFldCount - 1
If j Mod 2 = 1 Then
oWordTbl.Cell(i + 1, j + 1) = Format(Nz(rst.Fields(j).Value, ""), "#,###")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 2
Else
oWordTbl.Cell(i + 1, j + 1) = Nz(rst.Fields(j).Value, "")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 1
End If
Next j
.MoveNext
Next i
Else
MsgBox "Khong co du lieu Ky han tra no.", vbCritical + vbOKOnly, "Thông báo"
GoTo Error_Handler_Exit
End If
End With
'Format bold 1st row'
With Doc.Tables(tblNoInDoc).Rows(1).Range
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.Cells.VerticalAlignment = 1
End With
Error_Handler_Exit:
On Error Resume Next
oApp.Visible = True 'Make Word visible to the user'
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set oWordTbl = Nothing
Set Doc = Nothing
Set oApp = Nothing
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End If
oApp.ActiveDocument.SaveAs Filename:="""" & CurrentProject.Path & "\Preview\TC" & "\" & "HDTDTC" & "_" & DLookup("Nguoidaidien", "T_KH2") & "_" & Me.DonvayTCngaychu & ".doc" & """"
Set oApp = Nothing
End Sub
Dạ em cảm ơn bác và mọi người rất nhiều, bác đã sửa lại hộ em đúng như ý muốn (có mỗi cái là code trên không có dòng: "On Error GoTo Error_Handler" mà bên dưới thì có "Error_Handler_Exit:" và "Error_Handler:" :=) , nhưng dù sao chương trình nhập liệu chuẩn và bảng biểu chuẩn làm đầu vào thì chả có lỗi gì nên không cần bẫy @@). Em cảm ơn ạ! -
RE: Liên kết bảng biểu Excel sang Word thông qua Access
vuthaiha90 > 24-02-17, 04:07 PM
Em quyết định sửa lại cuối cùng như thế này, sau khi nhập dữ liệu bên Excel xong khỏi cần chọn tệp tin gì cả (miễn sao mọi người đừng di chuyển file này sang vị trí khác hoặc đổi tên), khi ấn "Xem và in" Hợp đồng tự động làm mấy thao tác luôn
Mã PHP:'---------------------------------------------------------'
'EXPORT TABLE VAO FILE DOC'- by ongke0711
'---------------------------------------------------------'
Const acImport = 0: Const acSpreadsheetTypeExcel9 = 8
Dim sTenTable As String
Dim strFileName As String
Dim outputFileName As String
outputFileName = CurrentProject.Path & "\Bang phan ky tra no trung han.xls"
strFileName = "tempFromExcel"
DoCmd.DeleteObject acTable = acDefault, "tempFromExcel"
DoCmd.TransferSpreadsheet acImport, , strFileName, outputFileName, True
If DLookup("SokytraTC", "T_infovayTC") > 1 Then
'Mo table can export qua file Doc'
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tempFromExcel", dbOpenSnapshot)
With rst
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query'
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query'
tblNoInDoc = 1 'So thu tu cua table trong file Doc'
Set oWordTbl = Doc.Tables(tblNoInDoc)
'Them cot'
With Doc.Tables(tblNoInDoc)
.Select
Do Until .Columns.Count = iFldCount
.Columns.Add
.Columns.AutoFit
Loop
End With
'Build our Header Row'
For i = 0 To iFldCount - 1
If i Mod 2 = 1 Then 'Xac dinh cot chan de dat ten cot giong nhau'
'oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name 'Get Field name from table Access'
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=2")
Else
oWordTbl.Cell(1, i + 1) = DLookup("TenCot", "tblTenCotTableWord", "ID=1")
End If
Next i
'Build our data rows'
For i = 1 To iRecCount
Doc.Tables(tblNoInDoc).Rows.Add
For j = 0 To iFldCount - 1
If j Mod 2 = 1 Then
oWordTbl.Cell(i + 1, j + 1) = Format(Nz(rst.Fields(j).Value, ""), "#,###") & ChrW(273)
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 2
Else
oWordTbl.Cell(i + 1, j + 1) = Nz(rst.Fields(j).Value, "")
oWordTbl.Cell(i + 1, j + 1).Range.ParagraphFormat.Alignment = 1
End If
Next j
.MoveNext
Next i
Else
MsgBox "Khong co du lieu Ky han tra no.", vbCritical + vbOKOnly, "Thông báo"
'GoTo Error_Handler_Exit
End If
End With
'Format bold 1st row'
With Doc.Tables(tblNoInDoc).Rows(1).Range
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.Cells.VerticalAlignment = 1
End With
'Error_Handler_Exit:
'On Error Resume Next
oApp.Visible = True 'Make Word visible to the user'
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set oWordTbl = Nothing
Set Doc = Nothing
'Set oApp = Nothing
'Exit Sub
'Error_Handler:
'MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
'"Error Number: " & Err.Number & vbCrLf & _
'"Error Source: Export2DOC" & vbCrLf & _
'"Error Description: " & Err.Description _
', vbOKOnly + vbCritical, "An Error has Occured!"
'Resume Error_Handler_Exit
Else
Doc.Tables(1).Select
oApp.Selection.Rows.Add
oApp.Selection.Columns.Add
oApp.Selection.Columns.Add
oApp.Selection.Columns.Add
Doc.Tables(1).Cell(1, 1).Range.Text = "Ngày, Tháng, N" & ChrW(259) & "m tr" & ChrW(7843) & " n" & ChrW(7907)
Doc.Tables(1).Cell(2, 1).Range.Text = Me.NgaydenhanTC
Doc.Tables(1).Cell(1, 2).Range.Text = "S" & ChrW(7889) & " ti" & ChrW(7873) & "n tr" & ChrW(7843) & " n" & ChrW(7907)
Doc.Tables(1).Cell(2, 2).Range.Text = Format(Me.SotienvayTC, "#,##0") & ChrW$(273)
Doc.Tables(1).Cell(1, 3).Range.Text = "Ngày, Tháng, N" & ChrW(259) & "m tr" & ChrW(7843) & " n" & ChrW(7907)
Doc.Tables(1).Cell(1, 4).Range.Text = "S" & ChrW(7889) & " ti" & ChrW(7873) & "n tr" & ChrW(7843) & " n" & ChrW(7907)
Doc.Tables(1).Columns.AutoFit
With Doc.Tables(1).Rows(1).Range
.Font.Bold = True
.ParagraphFormat.Alignment = 1 '1 la Can giua
.Cells.VerticalAlignment = 1
End With
With Doc.Tables(1).Cell(2, 1).Range
.ParagraphFormat.Alignment = 1
.Cells.VerticalAlignment = 1
End With
With Doc.Tables(1).Cell(2, 2).Range
.ParagraphFormat.Alignment = 2 '2 la can phai; 3 la can deu 2 ben
.Cells.VerticalAlignment = 1
End With
End If