Macro thay thế mail merge >> export thành file PDF

[AnhNQT]

Xin chào mọi người ạ!
Em cần giúp đỡ tạo macro trên excel để thay thế mail merge và sau đó lưu (in) thành file PDF.
Cụ thể như sau ạ:
Thông tin dữ liệu từ sheet "Relates" được đẩy vào sheet "INVOICE" với vị trí được bôi vàng và em đã để hàm = sẵn r ạ.
Mỗi "invoice no" khác nhau là tạo ra 1 file invoice hoàn chỉnh khác nhau. ví dụ kia có 2 "invoice no" thì sẽ chạy ra đc 2 sheet invoice chứa đủ nội dung.
Mỗi invoice no có thể có tối đa 4 "content" được xuất ra trong invoice.
Em chân thành cảm ơn!

 

[vanthinh3101]

Xin chào mọi người ạ!
Em cần giúp đỡ tạo macro trên excel để thay thế mail merge và sau đó lưu (in) thành file PDF.
Cụ thể như sau ạ:
Thông tin dữ liệu từ sheet "Relates" được đẩy vào sheet "INVOICE" với vị trí được bôi vàng và em đã để hàm = sẵn r ạ.
Mỗi "invoice no" khác nhau là tạo ra 1 file invoice hoàn chỉnh khác nhau. ví dụ kia có 2 "invoice no" thì sẽ chạy ra đc 2 sheet invoice chứa đủ nội dung.
Mỗi invoice no có thể có tối đa 4 "content" được xuất ra trong invoice.
Em chân thành cảm ơn!

Gửi bạn tham khảo.
Cách sử dụng:
- Bạn lập danh sách Invoice cần tạo file pdf và điền vào cột X sheets("Relates"), từ ô X3 trở đi và Click button Print_Invoice
- Yêu cầu: các dòng thông tin của 1 hóa đơn phải liền kề nhau, không được tách rời, cách quãng.

Sub Print_Invoice()
    Dim lR As Long, Invoice(), I As Long
    
    'Dong cuoi chua du lieu o cot X
    lR = Sheet5.Range("X" & Rows.Count).End(xlUp).Row
    
    If lR > 3 Then
        Invoice() = Sheet5.Range("X3:X" & lR)
        For I = 1 To UBound(Invoice, 1)
            Call Fill_Information(CStr(Invoice(I, 1)))
        Next I
    ElseIf lR = 3 Then
        Call Fill_Information(CStr(Sheet5.Range("X3")))
    Else
        MsgBox "Chua co thong tin Invoice can in", vbCritical, "GPE"
        Exit Sub
    End If
    
    MsgBox "Done", vbInformation, "GPE"
End Sub

Sub Fill_Information(Invoice_No As String)
    Dim Arr, sArr(), tArr()
    Dim I As Long, J As Long, K As Long
    Dim sR As Long, Items As Long, lR As Long
    
    Application.ScreenUpdating = False
    
    'Mang chua cac vi tri can dien thong tin cua sheet INVOICE
    Arr = Array("AS26", "U15", "V14", "U17", "W18", "", "", "", "", "", "", "F35", "H36", "AN23", "B8", "B10", "B15", "B17", "C16", "AP21")

    With Sheet5
        'Dong cuoi cung chua du lieu cua sheet Relates
        lR = .Range("E" & Rows.Count).End(xlUp).Row
        
        'Mang 2 chieu chua toan bo thong tin sheet Relates
        sArr() = .Range("A3:T" & lR).Value
        
        'Chay vong lap qua tung dong cua sheet Relates
        For I = 1 To UBound(sArr, 1)
            If sArr(I, 5) = Invoice_No Then
                Items = Items + 1               'Dem so dong chua thong tin cua Invoice_No
                If Items = 1 Then sR = I + 2    'Dong dau tien co thong tin cua Invoice_No
            End If
        Next I
        
        'Mang 2 chieu chua toan bo thong tin cua Invoice_No
        tArr() = .Range("A" & sR).Resize(Items, 20).Value
    End With
        
    '----Dien ket qua sang sheet INVOICE tai cac vi tri chi co 1 gia tri
    With Sheet1
        'Chay vong lap qua tung vi tri cua mang Arr
        For I = 0 To UBound(Arr)
            If Len(Arr(I)) Then .Range(Arr(I)) = tArr(1, I + 1)
        Next I
        
        '----Dien ket qua sang sheet INVOICE tai cac vi tri nhieu
        'Xoa thong tin hang hoa cu
        .Range("D23:Z30").ClearContents
        .Range("W31:Z32").ClearContents
        'Chay vong lap qua tung vi tri cua mang tArr
        For I = 1 To UBound(tArr, 1)
            .Range("D23").Offset(I * 2 - 2).MergeArea = tArr(I, 6)
            .Range("N23").Offset(I * 2 - 2).MergeArea = tArr(I, 7)
            .Range("Q23").Offset(I * 2 - 2).MergeArea = tArr(I, 8)
            .Range("T23").Offset(I * 2 - 2).MergeArea = tArr(I, 9)
            .Range("W23").Offset(I * 2 - 2).MergeArea = tArr(I, 11)
            .Range("W31").Value = .Range("W31").Value + tArr(I, 10)
        Next I
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Invoice_No & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    End With
    Application.ScreenUpdating = True
End Sub

 

[AnhNQT]

Rất cảm ơn bác đã hỗ trợ! Code chạy OK r và rất chi tiết để em có thể sửa khi có thay đổi form.