Xuất dữ liệu từ Excel sang Word

[axa00000019]

Chào các anh/ chị,
Hiện em đang muốn xuất dữ liệu với nội dung từ file Excel sang file Word (mẫu sẵn), điền nội dung vào các vị trí cố định. Và sao chép bảng nội dung hàng hóa trong Excel dán sang Word mà vẫn giữ được định dạng (như file mẫu). Cả nhà có thể giúp em đoạn code VBA để thực hiện vấn đề khó này. Xin cảm ơn cả nhà!

 

[Xê e rờ 7]

Xem thử file dùng cách này đươc ko

 

[giaiphap]

Chào các anh/ chị,
Hiện em đang muốn xuất dữ liệu với nội dung từ file Excel sang file Word (mẫu sẵn), điền nội dung vào các vị trí cố định. Và sao chép bảng nội dung hàng hóa trong Excel dán sang Word mà vẫn giữ được định dạng (như file mẫu). Cả nhà có thể giúp em đoạn code VBA để thực hiện vấn đề khó này. Xin cảm ơn cả nhà!

Cái này mình tạo BoolMark cho file word. Bạn xem chi tiết các bookmark sẽ rõ. Đặt 2 file này cùng thư mục nhé.

 

[axa00000019]

Cái này mình tạo BoolMark cho file word. Bạn xem chi tiết các bookmark sẽ rõ. Đặt 2 file này cùng thư mục nhé.

File rất ổn. Anh có thể giúp em phần số chuyển sang có định dạng dấu chấm được không ạ. Rất cảm ơn anh vì sự giúp đỡ.!

 

[giaiphap]

File rất ổn. Anh có thể giúp em phần số chuyển sang có định dạng dấu chấm được không ạ. Rất cảm ơn anh vì sự giúp đỡ.!

Sửa lại code ExportToWord như sau:

Sub ExportToWord()
    Dim docFilename As Object, wordApp As Object
    Dim i As Integer, j As Integer, k As Integer, tbl
    On Error GoTo Thoat
    j = Sheet1.Range("A10000").End(xlUp).Row - 7
    Set wordApp = CreateObject("Word.Application")
        Set docFilename = wordApp.documents.Open(ThisWorkbook.Path & Application.PathSeparator & "BIEN_BAN_NGHIEM_THU_BAN_GIAO.docx")
        For i = 1 To 3
            UpdateBookmarkContent docFilename, "SOHD" & i, Sheet1.Range("B2").Value
            If i <> 0 Then UpdateBookmarkContent docFilename, "NGAYKY" & i, Sheet1.Range("B3").Value
        Next i
        UpdateBookmarkContent docFilename, "GIATRI", Format(Sheet1.Range("B4").Value, "###,0")
        UpdateBookmarkContent docFilename, "SOTIEN", Sheet1.Range("B13").Value
        With docFilename.Tables(1)
            If .Rows.Count >= j + 1 Then
                For i = .Rows.Count - j To 2 Step -1
                    .Rows(i).Delete
                Next i
            Else
                For i = 1 To j - .Rows.Count + 1
                    .Rows.Add
                Next i
            End If
            For i = 1 To j
                For k = 1 To 7
                    If k > 5 Then
                        .cell(i + 1, k) = Format(Sheet1.Cells(i + 6, k).Value, "###,0")
                    Else
                        .cell(i + 1, k) = Sheet1.Cells(i + 6, k).Value
                    End If
                Next k
            Next i
        End With
        docFilename.Close True
        Set docFilename = Nothing
    Set wordApp = Nothing
    MsgBox "Da thuc hien xong", , "---GPE---"
    Exit Sub
Thoat:
        docFilename.Close False
        Set docFilename = Nothing
    Set wordApp = Nothing
    MsgBox "Da co loi xu ly", , "---GPE---"
End Sub

 

[axa00000019]

Sửa lại code ExportToWord như sau:

Sub ExportToWord()
    Dim docFilename As Object, wordApp As Object
    Dim i As Integer, j As Integer, k As Integer, tbl
    On Error GoTo Thoat
    j = Sheet1.Range("A10000").End(xlUp).Row - 7
    Set wordApp = CreateObject("Word.Application")
        Set docFilename = wordApp.documents.Open(ThisWorkbook.Path & Application.PathSeparator & "BIEN_BAN_NGHIEM_THU_BAN_GIAO.docx")
        For i = 1 To 3
            UpdateBookmarkContent docFilename, "SOHD" & i, Sheet1.Range("B2").Value
            If i <> 0 Then UpdateBookmarkContent docFilename, "NGAYKY" & i, Sheet1.Range("B3").Value
        Next i
        UpdateBookmarkContent docFilename, "GIATRI", Format(Sheet1.Range("B4").Value, "###,0")
        UpdateBookmarkContent docFilename, "SOTIEN", Sheet1.Range("B13").Value
        With docFilename.Tables(1)
            If .Rows.Count >= j + 1 Then
                For i = .Rows.Count - j To 2 Step -1
                    .Rows(i).Delete
                Next i
            Else
                For i = 1 To j - .Rows.Count + 1
                    .Rows.Add
                Next i
            End If
            For i = 1 To j
                For k = 1 To 7
                    If k > 5 Then
                        .cell(i + 1, k) = Format(Sheet1.Cells(i + 6, k).Value, "###,0")
                    Else
                        .cell(i + 1, k) = Sheet1.Cells(i + 6, k).Value
                    End If
                Next k
            Next i
        End With
        docFilename.Close True
        Set docFilename = Nothing
    Set wordApp = Nothing
    MsgBox "Da thuc hien xong", , "---GPE---"
    Exit Sub
Thoat:
        docFilename.Close False
        Set docFilename = Nothing
    Set wordApp = Nothing
    MsgBox "Da co loi xu ly", , "---GPE---"
End Sub

Ổn rồi ạ, cảm ơn anh nhiều lắm!

 

[Sajur Karl]

Cái này mình tạo BoolMark cho file word. Bạn xem chi tiết các bookmark sẽ rõ. Đặt 2 file này cùng thư mục nhé.

Dạ a, e cũng có 1 bài toán tương tự như vậy. Là mapping dữ liệu từng dòng bên excel qua form có sẵn bên word.
A cho e hỏi là có cách nào để mình nhét tất cả vô 1 file word k ạ, vì hiện tại của e đang là mỗi dòng ra 1 file word ạ. hơi bất tiện khi in
Cảm ơn a

 

[soap1234]

Anh chị có thể bổ sung phần lưu tên file nữa ko ạ

 

[soap1234]

Nếu bổ sung phần lưu tên file ra word thì như thế nào cả nhà nhỉ