[Giúp đỡ] Tối ưu tốc độ in từ Excel qua PDF

hungtin1997 · 30/10/20

Chào mọi người, hiện tại công việc yêu cầu em phải in 1 sheet cố định của nhiều file Excel sang PDF
Mò mẫm trên mạng và chỉnh sửa "tè le" thì được một đoạn code cũng đáp ứng được nhưng tốc độ khá chậm.
Không biết là do code hay do tiến trình in qua PDF buộc phải có tốc độ đó. Nhờ mọi người giúp em tối ưu đoạn code để được nhanh hơn, quan trọng là học hỏi thêm về cách tối ưu.
Các anh/chị đừng quan tâm chuyện em màu mè thêm mấy cái thông báo lằng nhằng, vấn đề ở đây là chỗ thực thi công việc thôi.
Em cảm ơn mọi người

Mã:

Sub inpdf()
Dim Chonfile As Variant
Dim i As Integer
Dim openfile As Workbook
Dim sh As Integer
Dim wb As Workbook
Dim tmr As Double
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo ErrorHandler
sh = InputBox("STT sheet can copy", "Thông Báo!")
Chonfile = Application.GetOpenFilename(Title:="Chon file", filefilter:="Excel file (*.xls*), *.xls*", MultiSelect:=True)
tmr = Timer()
Sheets.Add After:=ActiveSheet
For i = 1 To UBound(Chonfile)
        Set openfile = Workbooks.Open(Chonfile(i))
       wb.ActiveSheet.Range("A" & i).Value = openfile.Name
        openfile.Sheets(sh).ExportAsFixedFormat Type:=xlTypePDF, Filename:=Left(Right(openfile.Name, Len(openfile.Name) - 6), 8), Quality:=xlQualityStandard, _
  IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
        openfile.Close False
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Assistant.DoAlert "THÔNG BÁO", ChrW(272) & "ã in " & UBound(Chonfile) & " file trong " & Left(Timer() - tmr, 4) & " giây" & vbCrLf & "Cùng " & ChrW(273) & ChrW(432) & ChrW(7901) & _
          "ng d" & ChrW(7851) & "n v" & ChrW(7899) & "i file Excel", 0, 4, 0, 0, 0
Exit Sub
ErrorHandler:
Application.Assistant.DoAlert "THÔNG BÁO", "Ch" & ChrW(432) & "a " & ChrW(273) & ChrW(7911) _
          & " " & ChrW(273) & "i" & ChrW(7873) & "u ki" & ChrW(7879) & "n " & ChrW( _
          273) & ChrW(7875) & " In", 0, 4, 0, 0, 0
Exit Sub
End Sub

hoamattroicoi · 30/10/20

Bạn sử dụng máy in của PM PDF sẽ tăng tốc độ được một chút, lần trước mình cũng bị chậm do save file excel to PDF.

Kiểu như vầy :

Mã:

Sub Macro4() ' Su dung may in cua PM PDF acrobat Reader
    Dim T
T = Timer()
  
    On Error GoTo Err_handler
  
    Dim Myfilename As String, lCal, Ws As Worksheet
    With Application
        .ScreenUpdating = False
        lCal = .Calculation
        .EnableEvents = False
    End With
  
    Myfilename = ThisWorkbook.Path & "\" & "PSW (" & Replace(Sheet6.[T2].Value, "-", "") & ")" & ".pdf"
  
    Set Ws = ActiveSheet
    Sheets(Array("PSW", "Drawing", "Dimension Result", "Performance test result", _
        "Material Test", "IMDS", "Control plan", "Cpk (Ref)", "GRR Ref")).Select
  
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
                                         Collate:=True, _
                                         PrToFileName:=Myfilename, _
                                         IgnorePrintAreas:=False
'Sheets("Drawing").Select
    Ws.Select
    MsgBox Timer() - T & "- Done"
  
lbl_Resume:
    With Application
        .ScreenUpdating = True
         .Calculation = lCal
        .EnableEvents = True
    End With
  
    Exit Sub
Err_handler:
    MsgBox "Loi: " & Err.Number & vbNewLine & Err.Description & vbNewLine & vbNewLine & Timer() - T & "- Done"
    Resume lbl_Resume
End Sub

Đây là code mình làm của mình, Bạn thử "mò mẫm" và chỉnh tiếp xem sao nhé.

hungtin1997 · 31/10/20

hoamattroicoi đã viết:

Bạn sử dụng máy in của PM PDF sẽ tăng tốc độ được một chút, lần trước mình cũng bị chậm do save file excel to PDF.
View attachment 248393
Kiểu như vầy :

Mã:

Sub Macro4() ' Su dung may in cua PM PDF acrobat Reader
    Dim T
T = Timer()
 
    On Error GoTo Err_handler
 
    Dim Myfilename As String, lCal, Ws As Worksheet
    With Application
        .ScreenUpdating = False
        lCal = .Calculation
        .EnableEvents = False
    End With
 
    Myfilename = ThisWorkbook.Path & "\" & "PSW (" & Replace(Sheet6.[T2].Value, "-", "") & ")" & ".pdf"
 
    Set Ws = ActiveSheet
    Sheets(Array("PSW", "Drawing", "Dimension Result", "Performance test result", _
        "Material Test", "IMDS", "Control plan", "Cpk (Ref)", "GRR Ref")).Select
 
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
                                         Collate:=True, _
                                         PrToFileName:=Myfilename, _
                                         IgnorePrintAreas:=False
'Sheets("Drawing").Select
    Ws.Select
    MsgBox Timer() - T & "- Done"
 
lbl_Resume:
    With Application
        .ScreenUpdating = True
         .Calculation = lCal
        .EnableEvents = True
    End With
 
    Exit Sub
Err_handler:
    MsgBox "Loi: " & Err.Number & vbNewLine & Err.Description & vbNewLine & vbNewLine & Timer() - T & "- Done"
    Resume lbl_Resume
End Sub

Đây là code mình làm của mình, Bạn thử "mò mẫm" và chỉnh tiếp xem sao nhé.

Ồ, bác làm bên chất lượng à, có CPK vậy?

tigertiger · 31/10/20

hungtin1997 đã viết:
Ồ, bác làm bên chất lượng à, có CPK vậy?

Ơ hay, cuối cùng bài #2 đó có giúp ích và nhanh nhiều chưa, mà lại chuyển sang chủ đề khác?

hungtin1997 · 2/11/20

hoamattroicoi đã viết:

Bạn sử dụng máy in của PM PDF sẽ tăng tốc độ được một chút, lần trước mình cũng bị chậm do save file excel to PDF.
View attachment 248393
Kiểu như vầy :

Mã:

Sub Macro4() ' Su dung may in cua PM PDF acrobat Reader
    Dim T
T = Timer()
 
    On Error GoTo Err_handler
 
    Dim Myfilename As String, lCal, Ws As Worksheet
    With Application
        .ScreenUpdating = False
        lCal = .Calculation
        .EnableEvents = False
    End With
 
    Myfilename = ThisWorkbook.Path & "\" & "PSW (" & Replace(Sheet6.[T2].Value, "-", "") & ")" & ".pdf"
 
    Set Ws = ActiveSheet
    Sheets(Array("PSW", "Drawing", "Dimension Result", "Performance test result", _
        "Material Test", "IMDS", "Control plan", "Cpk (Ref)", "GRR Ref")).Select
 
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
                                         Collate:=True, _
                                         PrToFileName:=Myfilename, _
                                         IgnorePrintAreas:=False
'Sheets("Drawing").Select
    Ws.Select
    MsgBox Timer() - T & "- Done"
 
lbl_Resume:
    With Application
        .ScreenUpdating = True
         .Calculation = lCal
        .EnableEvents = True
    End With
 
    Exit Sub
Err_handler:
    MsgBox "Loi: " & Err.Number & vbNewLine & Err.Description & vbNewLine & vbNewLine & Timer() - T & "- Done"
    Resume lbl_Resume
End Sub

Đây là code mình làm của mình, Bạn thử "mò mẫm" và chỉnh tiếp xem sao nhé.

tigertiger đã viết:
Ơ hay, cuối cùng bài #2 đó có giúp ích và nhanh nhiều chưa, mà lại chuyển sang chủ đề khác?

Thì đang "mò mẫm" đây nên mới phát hiện bác ấy làm bên chất lượng, vì mình cùng làm bên chất lượng muốn học hỏi thêm nên bắt chuyện chứ chuyển chủ đề gì đâu bác

Bài đã được tự động gộp: 2/11/20

hoamattroicoi đã viết:

Bạn sử dụng máy in của PM PDF sẽ tăng tốc độ được một chút, lần trước mình cũng bị chậm do save file excel to PDF.
View attachment 248393
Kiểu như vầy :

Mã:

Sub Macro4() ' Su dung may in cua PM PDF acrobat Reader
    Dim T
T = Timer()
 
    On Error GoTo Err_handler
 
    Dim Myfilename As String, lCal, Ws As Worksheet
    With Application
        .ScreenUpdating = False
        lCal = .Calculation
        .EnableEvents = False
    End With
 
    Myfilename = ThisWorkbook.Path & "\" & "PSW (" & Replace(Sheet6.[T2].Value, "-", "") & ")" & ".pdf"
 
    Set Ws = ActiveSheet
    Sheets(Array("PSW", "Drawing", "Dimension Result", "Performance test result", _
        "Material Test", "IMDS", "Control plan", "Cpk (Ref)", "GRR Ref")).Select
 
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
                                         Collate:=True, _
                                         PrToFileName:=Myfilename, _
                                         IgnorePrintAreas:=False
'Sheets("Drawing").Select
    Ws.Select
    MsgBox Timer() - T & "- Done"
 
lbl_Resume:
    With Application
        .ScreenUpdating = True
         .Calculation = lCal
        .EnableEvents = True
    End With
 
    Exit Sub
Err_handler:
    MsgBox "Loi: " & Err.Number & vbNewLine & Err.Description & vbNewLine & vbNewLine & Timer() - T & "- Done"
    Resume lbl_Resume
End Sub

Đây là code mình làm của mình, Bạn thử "mò mẫm" và chỉnh tiếp xem sao nhé.

Sheet của em là set trang sẵn rồi bác, chỉ cần in thôi, cảm ơn bác đã hỗ trợ, em nghĩ nó lâu là do in qua PDF, vì em thấy khi nó load qua PDF thì thời gian của hai code là như nhau.

hoamattroicoi · 2/11/20

hungtin1997 đã viết:
Thì đang "mò mẫm" đây nên mới phát hiện bác ấy làm bên chất lượng, vì mình cùng làm bên chất lượng muốn học hỏi thêm nên bắt chuyện chứ chuyển chủ đề gì đâu bác

Sheet của em là set trang sẵn rồi bác, chỉ cần in thôi, cảm ơn bác đã hỗ trợ, em nghĩ nó lâu là do in qua PDF, vì em thấy khi nó load qua PDF thì thời gian của hai code là như nhau.

Đúng là người trong nghề có khác, nhìn biết luôn code của bộ phận chất lượng

- mình thì không làm bên chất lượng nhưng code này đúng là mình làm cho mấy anh bên phòng chất lượng đó bạn. Họ cần kết xuất ra pdf để upload trên hệ thống đánh giá chất lượng của khách hàng.
Lúc đầu mình có export như bạn nhưng cũng bị lâu vì file nặng, mình chuyển qua máy in của PM in pdf thì tốc độ nhanh hơn chút đó bạn.
Mình thử lại xem.

hungtin1997 · 2/11/20

hoamattroicoi đã viết:
Đúng là người trong nghề có khác, nhìn biết luôn code của bộ phận chất lượng - mình thì không làm bên chất lượng nhưng code này đúng là mình làm cho mấy anh bên phòng chất lượng đó bạn. Họ cần kết xuất ra pdf để upload trên hệ thống đánh giá chất lượng của khách hàng.
Lúc đầu mình có export như bạn nhưng cũng bị lâu vì file nặng, mình chuyển qua máy in của PM in pdf thì tốc độ nhanh hơn chút đó bạn.
Mình thử lại xem.

Đúng vậy, phải in ra PDF mới gửi khách hàng được chứ đâu thể gửi file Excel, cảm ơn bác đã quan tâm, mình xin kết thúc topic ở đây.

[Giúp đỡ] Tối ưu tốc độ in từ Excel qua PDF

hungtin1997

Dậm chân tại chỗ là đi lùi

hoamattroicoi

Thành viên gắn bó

hungtin1997

Dậm chân tại chỗ là đi lùi

tigertiger

Coming back ...

hungtin1997

Dậm chân tại chỗ là đi lùi

hoamattroicoi

Thành viên gắn bó

hungtin1997

Dậm chân tại chỗ là đi lùi

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng