Nhờ hướng dẫn cách gộp các file word

Chia sẻ bởi:hands

★★★★★

‹ Xin hỏi về các file word có... Gộp nhiều file word và giữ nguyên... ›

Quảng cáo

Tôi thường phải copy/paste rất nhiều file word vào 1 file tổng hợp, nên rất muốn tìm cách gộp tự động. Tôi đã thử INSERT/OBJECT/TEXT FROM FILE nhưng kết quả sau khi insert tự động thì các file bị đè chồng lên nhau ngay tại trang 1.

Hiện tại, tôi gửi file đính kèm, giả dụ có 5 file word, trong cùng 1 thư mục
– File 1: 1 page
– File 2: 2 page
– File 3: 2 page
– File 4: 1 page
– File 5: 1 page

Yêu cầu: File tổng hợp , sẽ bao gồm 5 file trên, và bao gồm thành 7 trang (xem file tổng hợp ví dụ, theo file đính kèm)

Rất mong các anh chị có kinh nhiệm chia sẻ giúp.

Cám ơn

Gộp nhiều tập tin Word bằng cách copy/paste bằng tay thì đơn giản hơn. Còn bằng code thì nhiều khi khó hơn nhiều khi các tập tin Word khác nhau về page layout, header, footer, page numbering, bookmarks và cross-references, Tables of Contents, Indexes v…v Nhất là khi các tập tin dùng những tên style như nhau nhưng được định nghĩa khác nhau.

18107

Nếu coi thường, lờ đi các vấn đề về page numbering, Tables of Contents or Indexes, về sự xung đột các footnote, endnote numbering và positioning, sự trùng lặp của các bookmark thì …

Do các tập tin của bạn là doc nên trong code có

Dir(strFolder & "*.doc")

Nếu là các "docx" thì sửa thành

Dir(strFolder & "*.docx")

Có thể không dùng Dir mà dùng FileSystemObject (tìm trên GPE)

Tải tập tin MergeWords.docm về để cùng thư mục với các tập tin DOC.

Code chỉ là ví dụ. Nếu không hài lòng thì tự tìm kiếm

Code chạy rất ok, tuy nhiên chỉ có bị lỗi phần giãn dòng, khiến cho chữ bị mất. (phần consignee, notify và description of goods)
Anh xem giúp em có cách nào khắc phục sự cố giãn dòng, sau khi copy/paste bằng code không? Em gửi file đính kèm, mong anh xem giúp.

Thử:
1. Xóa Sub CopyPageSetup

2. Sub MergeWords mới

Sub MergeWords()
Dim strFolder As String, strFile As String, strDest As String
Dim srcDoc As Document
    Application.ScreenUpdating = False
    strFolder = ThisDocument.Path & ""
    strDest = ThisDocument.FullName
    strFile = Dir(strFolder & "*.doc")
    Do While strFile <> ""
        If strFolder & strFile <> strDest Then
            Set srcDoc = Documents.Open(strFolder & strFile)
            Selection.WholeStory
            Selection.Copy
            With ThisDocument
                .Activate
                Selection.PasteAndFormat (wdFormatOriginalFormatting)
                Selection.Start = .Content.End
                Selection.InsertBreak (wdSectionBreakNextPage)
            End With
            srcDoc.Close False
        End If
        strFile = Dir()
    Loop
    With ThisDocument
        .SaveAs2 strFolder & "Tonghop.docx", wdFormatXMLDocument
        .Close False
    End With
    Set srcDoc = Nothing
    Application.ScreenUpdating = True
End Sub

Khóa học SprinGO phù hợp

Kỹ năng giải quyết vấn đề hiệu quả

Mô tả Nội dung Đánh giá Tài nguyên KỸ NĂNG GIẢI QUYẾT VẤN ĐỀ HIỆU QUẢHiểu đúng vấn đề là một nửa của giải...

Xem khóa học

★★★★★ 5 ★ 1 👤 2 ▥ 0

‹ Xin hỏi về các file word có đuôi... Gộp nhiều file word và giữ nguyên số... ›

Quảng cáo

Bạn nên đọc

Email Word with Message (Uses xlDialogSendMail & Outlook Express)

2 Responses

hands says:

17/03/2023 at 1:21 pm

Em tham khảo file này của anh có đoạn code em cần.

Sub MergeWords_GiaiPhap()
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFile       As Object
    Dim oFiles      As Object
    Dim strFolder   As String
    Dim strDest     As String
    Dim kt          As Boolean
    Application.ScreenUpdating = False
    strFolder = ThisDocument.Path & ""
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(strFolder)
    Set oFiles = oFolder.Files
    strDest = ThisDocument.FullName
    kt = False
    For Each oFile In oFiles
        If UCase(Right(oFile.Name, 3)) = "DOC" Then
            If strFolder & oFile.Name <> strDest Then
                If kt Then Selection.InsertBreak Type:=wdPageBreak
                Selection.InsertFile FileName:=strFolder & oFile.Name, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
                kt = True
            End If
        End If
    Next oFile
    With ThisDocument
        .SaveAs2 strFolder & "Tonghop.docx", wdFormatXMLDocument
        .Close False
    End With
    Set oFSO = Nothing
    Set oFolder = Nothing
    Set oFiles = Nothing
    Application.ScreenUpdating = True
End Sub

hands says:

17/03/2023 at 1:22 pm

Sub MergeWords_GiaiPhap()
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFile       As Object
    Dim oFiles      As Object
    Dim strFolder   As String
    Dim strDest     As String
    Dim kt          As Boolean
    Application.ScreenUpdating = False
    strFolder = ThisDocument.Path & ""
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(strFolder)
    Set oFiles = oFolder.Files
    strDest = ThisDocument.FullName
    kt = False
    For Each oFile In oFiles
        If UCase(Right(oFile.Name, 4)) = "DOCX" Then
            If strFolder & oFile.Name <> strDest Then
                If kt Then Selection.InsertBreak Type:=wdPageBreak
                Selection.InsertFile FileName:=strFolder & oFile.Name, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
                kt = True
            End If
        End If
    Next oFile
    With ThisDocument
        .SaveAs2 strFolder & "Tonghop.docx", wdFormatXMLDocument
        .Close False
    End With
    Set oFSO = Nothing
    Set oFolder = Nothing
    Set oFiles = Nothing
    Application.ScreenUpdating = True
End Sub