Xuất dữ liệu ra file PDF

[saobekhonglac]

Chào Anh/Chị.

Nhờ Anh/Chị viết giúp Em code xuất sheet “Xuat PDF” thành file PDF và lưu tất cả MSKH (tên file theo MSKH) theo từng Nhân viên phụ trách giúp (mỗi nhân viên phụ trách đã có 1 folder).
Sheet “Xuat PDF” sẽ lấy dữ liệu từ sheet “Du lieu”. Dữ liệu nếu có đầy đủ thì sẽ có 2 trang. Nhưng nếu có những Khách hàng có những dòng không phát sinh thì mình sẽ ẩn đi những dòng không có dữ liệu (cột I mình có làm ghi chú: nếu là chữ Ẩn thì sẽ Ẩn dòng đó đi rồi mới xuất PDF để rút gọn lại).

Mình có xuất sẵn 2 file PDF mẫu đính kèm.
Cám ơn Anh/Chị.

Chúc cuối tuần vui.

 

[snow25]

Chào Anh/Chị.

Nhờ Anh/Chị viết giúp Em code xuất sheet “Xuat PDF” thành file PDF và lưu tất cả MSKH (tên file theo MSKH) theo từng Nhân viên phụ trách giúp (mỗi nhân viên phụ trách đã có 1 folder).
Sheet “Xuat PDF” sẽ lấy dữ liệu từ sheet “Du lieu”. Dữ liệu nếu có đầy đủ thì sẽ có 2 trang. Nhưng nếu có những Khách hàng có những dòng không phát sinh thì mình sẽ ẩn đi những dòng không có dữ liệu (cột I mình có làm ghi chú: nếu là chữ Ẩn thì sẽ Ẩn dòng đó đi rồi mới xuất PDF để rút gọn lại).

Mình có xuất sẵn 2 file PDF mẫu đính kèm.
Cám ơn Anh/Chị.

Chúc cuối tuần vui.

Đây toàn công thức à.Bỏ hết được không dùng nguyên code.

 

[saobekhonglac]

Đây toàn công thức à.Bỏ hết được không dùng nguyên code.

Để công thức đi Anh vì có thể còn phát sinh thêm vì tiêu đề 2 sheet có thể khác nhau hoặc có những trường gõ tay để làm tiêu đề nên dùng công thức sẽ tiện khi có thay đổi.

Cám ơn.

 

[snow25]

Để công thức đi Anh vì có thể còn phát sinh thêm vì tiêu đề 2 sheet có thể khác nhau hoặc có những trường gõ tay để làm tiêu đề nên dùng công thức sẽ tiện khi có thay đổi.

Cám ơn.

Thử code.

Sub tachpdf()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, lr As Long, duonglink, j As Long
    With Sheets("Du lieu")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr = 1 Then Exit Sub
         arr = .Range("A2:B" & lr).Value
    End With
    With Sheets("Xuat PDF")
         For i = 1 To UBound(arr)
             .Range("B5").Value = arr(i, 1)
             For j = 10 To 80
                 If .Cells(j, 2).Value = 0 Then
                    .Rows(j).EntireRow.Hidden = True
                 Else
                    .Rows(j).EntireRow.Hidden = False
                 End If
             Next j
             duonglink = ThisWorkbook.Path & "\" & arr(i, 1) & ".PDF"
             .ExportAsFixedFormat xlTypePDF, duonglink
        Next i
   End With
End Sub

 

[befaint]

Làm việc với File cần kiểm tra trùng tên/ đường dẫn, giữa các lần thực hiện xuất File..

 

[VetMini]

Làm việc với File cần kiểm tra trùng tên/ đường dẫn, giữa các lần thực hiện xuất File..

Ở đây (GPE) đâu có ai ngại chuyện "bút sa gà chết" đâu.
Làm thì cứ việc lo cái file được xuất ra. Chuyện cái file trước đó bị chép chồng đâu phải của mình.

 

[saobekhonglac]

Thử code.

Sub tachpdf()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, lr As Long, duonglink, j As Long
    With Sheets("Du lieu")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr = 1 Then Exit Sub
         arr = .Range("A2:B" & lr).Value
    End With
    With Sheets("Xuat PDF")
         For i = 1 To UBound(arr)
             .Range("B5").Value = arr(i, 1)
             For j = 10 To 80
                 If .Cells(j, 2).Value = 0 Then
                    .Rows(j).EntireRow.Hidden = True
                 Else
                    .Rows(j).EntireRow.Hidden = False
                 End If
             Next j
             duonglink = ThisWorkbook.Path & "\" & arr(i, 1) & ".PDF"
             .ExportAsFixedFormat xlTypePDF, duonglink
        Next i
   End With
End Sub

Cám ơn Anh. Đã xuất được ra PDF nhưng chưa lưu được từng MSKH vào từng Folder Sales (lưu ngay thư mục chứa file). Và file xuất ra nó hơi chậm (5 phút xuất được khoảng 60-70 file, nếu 6,000 MSKH thì mất khoảng 1 ngày làm việc).

 

[snow25]

Cám ơn Anh. Đã xuất được ra PDF nhưng chưa lưu được từng MSKH vào từng Folder Sales (lưu ngay thư mục chứa file). Và file xuất ra nó hơi chậm (5 phút xuất được khoảng 60-70 file, nếu 6,000 MSKH thì mất khoảng 1 ngày làm việc).

Lưu vào foder nào thì phải có thông tin chứ.Ai biết bạn muốn nó lưu vào đâu.Còn về chậm thì mình đã bảo rồi dùng công thức thì nó sẽ chậm.Vì nó phải chạy hết công thức xong lại còn ẩn dòng với hiện dòng nữa.Mà còn vấn đề nữa là khi xuất PDF thì bạn thử xuất bằng lưu file PDF xem nó có nhanh không.

 

[VetMini]

Lưu vào foder nào thì phải có thông tin chứ.Ai biết bạn muốn nó lưu vào đâu.Còn về chậm thì mình đã bảo rồi dùng công thức thì nó sẽ chậm.Vì nó phải chạy hết công thức xong lại còn ẩn dòng với hiện dòng nữa.Mà còn vấn đề nữa là khi xuất PDF thì bạn thử xuất bằng lưu file PDF xem nó có nhanh không.

Đọc ở bài #1: 6000 khách hàng, nhiều nhân viên phụ trách. Cơ quan này đâu có nhỏ.
Bây giờ muốn quản lý bằng Excel và lưu trữ hồ sơ bằng pdf. Thua.
Tầm cỡ này thì nên gửi người quản lý đi học một khoá quản lý hồ sơ theo kỹ thuật số, về tổ chức lại cách quản lý.

 

[Quang_Hải]

Cám ơn Anh. Đã xuất được ra PDF nhưng chưa lưu được từng MSKH vào từng Folder Sales (lưu ngay thư mục chứa file). Và file xuất ra nó hơi chậm (5 phút xuất được khoảng 60-70 file, nếu 6,000 MSKH thì mất khoảng 1 ngày làm việc).

Thử cách này xem coi có phù hợp hay không. Chú ý các điểm sau
1. Sheet Xuat PDF đã xóa hết công thức, không sử dụng điều kiện để ẩn dòng. Dòng Tổng được sửa lại xíu cho đễ code và không cần format ô cho nhanh
2. Tên khách hàng và nhân viên sales được lưu tự động trong quá trình xuất file
3. Mặc định là các thư mục của nhân viên sales đang có sẵn trong thư mục chứa file tổng này. Các file có sẵn trùng tên sẽ bị xóa mất khi lưu file mới
4. Với cách này mỗi phút xuất khoảng 120 đến 150 files tùy theo máy khỏe hay máy "bệnh"

Option Explicit

Sub To_PDF()
Application.ScreenUpdating = False
Dim sArr(), i As Long, j As Long, Path As String, k  As Long, res(), n As Long, tong As Long
Dim fso As Object, New_File_Name As String
Set fso = CreateObject("scripting.filesystemobject")
Path = ThisWorkbook.Path
With Sheets("Du Lieu")
   sArr = .Range("A1", .[A65536].End(3)).Resize(, 68).Value
End With


For i = 2 To UBound(sArr)
   k = 0
   ReDim res(1 To UBound(sArr, 2), 1 To 3)
   For j = 5 To UBound(sArr, 2)
      If sArr(i, j) > 0 Then
         k = k + 1
         res(k, 1) = sArr(1, j)
         res(k, 2) = sArr(i, j)
      End If
      If j = 56 Then
         k = k + 1
         For n = 5 To 56
            tong = tong + sArr(i, n)
         Next
         res(k, 2) = "TOTAL"
         res(k, 3) = tong
         tong = 0
      End If
      If j = 62 Then
         k = k + 1
         For n = 57 To 62
            tong = tong + sArr(i, n)
         Next
         res(k, 2) = "TOTAL"
         res(k, 3) = tong
         tong = 0
      End If
      If j = 68 Then
         k = k + 1
         For n = 63 To 68
            tong = tong + sArr(i, n)
         Next
         res(k, 2) = "TOTAL"
         res(k, 3) = tong
         tong = 0
      End If
   Next
   With Sheets("Xuat PDF")
      .[B5] = sArr(i, 1)
      .[B6] = sArr(i, 2)
      .[B7] = sArr(i, 4)
      .[A10:C100].ClearContents
      .[A10].Resize(k, 3) = res
      New_File_Name = Path & "\" & sArr(i, 4) & "\" & sArr(i, 1) & ".PDF"
      If fso.fileexists(New_File_Name) Then fso.deletefile (New_File_Name)
      .ExportAsFixedFormat xlTypePDF, New_File_Name
   End With
Next
Application.ScreenUpdating = True
End Sub

 

[saobekhonglac]

Thử cách này xem coi có phù hợp hay không. Chú ý các điểm sau
1. Sheet Xuat PDF đã xóa hết công thức, không sử dụng điều kiện để ẩn dòng. Dòng Tổng được sửa lại xíu cho đễ code và không cần format ô cho nhanh
2. Tên khách hàng và nhân viên sales được lưu tự động trong quá trình xuất file
3. Mặc định là các thư mục của nhân viên sales đang có sẵn trong thư mục chứa file tổng này. Các file có sẵn trùng tên sẽ bị xóa mất khi lưu file mới
4. Với cách này mỗi phút xuất khoảng 120 đến 150 files tùy theo máy khỏe hay máy "bệnh"

Option Explicit

Sub To_PDF()
Application.ScreenUpdating = False
Dim sArr(), i As Long, j As Long, Path As String, k  As Long, res(), n As Long, tong As Long
Dim fso As Object, New_File_Name As String
Set fso = CreateObject("scripting.filesystemobject")
Path = ThisWorkbook.Path
With Sheets("Du Lieu")
   sArr = .Range("A1", .[A65536].End(3)).Resize(, 68).Value
End With


For i = 2 To UBound(sArr)
   k = 0
   ReDim res(1 To UBound(sArr, 2), 1 To 3)
   For j = 5 To UBound(sArr, 2)
      If sArr(i, j) > 0 Then
         k = k + 1
         res(k, 1) = sArr(1, j)
         res(k, 2) = sArr(i, j)
      End If
      If j = 56 Then
         k = k + 1
         For n = 5 To 56
            tong = tong + sArr(i, n)
         Next
         res(k, 2) = "TOTAL"
         res(k, 3) = tong
         tong = 0
      End If
      If j = 62 Then
         k = k + 1
         For n = 57 To 62
            tong = tong + sArr(i, n)
         Next
         res(k, 2) = "TOTAL"
         res(k, 3) = tong
         tong = 0
      End If
      If j = 68 Then
         k = k + 1
         For n = 63 To 68
            tong = tong + sArr(i, n)
         Next
         res(k, 2) = "TOTAL"
         res(k, 3) = tong
         tong = 0
      End If
   Next
   With Sheets("Xuat PDF")
      .[B5] = sArr(i, 1)
      .[B6] = sArr(i, 2)
      .[B7] = sArr(i, 4)
      .[A10:C100].ClearContents
      .[A10].Resize(k, 3) = res
      New_File_Name = Path & "\" & sArr(i, 4) & "\" & sArr(i, 1) & ".PDF"
      If fso.fileexists(New_File_Name) Then fso.deletefile (New_File_Name)
      .ExportAsFixedFormat xlTypePDF, New_File_Name
   End With
Next
Application.ScreenUpdating = True
End Sub

Cách này thì máy em chạy khoảng 2-3 phút là được 100 file. Nhưng bất tiện là công thức không còn, File gốc nó có nhiều thông tin bên sheet "Xuat PDF" không trùng với tiêu đề của Sheet "Du Lieu" nên phải dùng công thức để cập nhật theo từng cột.

Nếu sửa lại công thức thì có thể nào 5' được 100 file trở lên không Anh.