优化VBA Excel打印 – 创buildPDF？
我正在打印一个完整的xlsx文件的文件夹。 我希望优化并使处理速度更快 – 发送20个页面到打印机需要大约40秒的时间，即20个不同文件中的一个页面。
我可以将这些页面中的每一个发送到PDF文件，然后将该PDF文件一次发送到打印机（然后我可以在页面的两面打印 – 这将是可怕的）
我宁愿这样做，因为当应用程序完成后，一次打印最多可打印300页。 所以我认为你可以看到能够使用双方的优点，只需要发送一个PDF文件到打印机。
任何帮助将是真棒，
当前代码：
Sub Print_Long_Sections(ByVal LongFolderPath As String) ' #################################################################################### ' # INTRO '------------------------------------------------------------------------------------- ' Purpose ' This procedure assist the user to print all the long section files in the ' folder that they saved the files to. This saves the need to open all the files ' ' ' ' #################################################################################### ' # DECLAIRATIONS '------------------------------------------------------------------------------------- ' OBJECTS Dim LongFolder As Folder Dim LongFile As File Dim OpenLong As Workbook Dim FileSystemObj As New FileSystemObject '------------------------------------------------------------------------------------- ' VARIABLES Dim iLoopVar As Long Dim DefaultPrinter As String ' #################################################################################### ' # PROCEDURE CODE '------------------------------------------------------------------------------------- ' optimise speed Application.ScreenUpdating = False '------------------------------------------------------------------------------------- ' Select the Printer DefaultPrinter = Application.ActivePrinter MsgBox "Select your printer" Application.Dialogs(xlDialogPrinterSetup).Show '------------------------------------------------------------------------------------- ' Print the Files in the Folder: Set LongFolder = FileSystemObj.GetFolder(LongFolderPath) '// set the folder object to the user specified folder For Each LongFile In LongFolder.Files '// loop through all the files in the folder If FileSystemObj.GetExtensionName(LongFile.Path) = "xlsx" Then '// check file is an xlsx file, If InStr(1, LongFile.Name, "PipeLongSec") > 0 Then '// check file is a long section Set OpenLong = Workbooks.Open(LongFile.Path) '// open the file OpenLong.Sheets(1).PrintOut '// send file to default printer OpenLong.Close '// close the file End If End If Next '------------------------------------------------------------------------------------- ' Re-Set Printer to Previous Settings Application.ActivePrinter = DefaultPrinter '------------------------------------------------------------------------------------- ' END PROCEDURE Application.ScreenUpdating = True Set OpenLong = Nothing Set LongFolder = Nothing Set LongFile = Nothing Set FileSystemObj = Nothing End Sub 问候，
乔
我成功地创造了我所需要的东西 – 一种将我创build的所有工作簿放入易于分发和打印的东西的方法。
代码不打印 – 而是创buildPDF：
Sub PDF_Long_Sections(ByVal LongFolderPath As String) ' #################################################################################### ' # INTRO '------------------------------------------------------------------------------------- ' Purpose ' This procedure assists the user to put all long sections from a folder into one ' PDF file. This makes it convieniet to share the long sections & print them. ' ' ' ' #################################################################################### ' # DECLAIRATIONS '------------------------------------------------------------------------------------- ' OBJECTS Dim LongFolder As Folder Dim LongFile As File Dim OpenLong As Workbook Dim ExportWB As Workbook Dim FileSystemObj As New FileSystemObject '------------------------------------------------------------------------------------- ' VARIABLES Dim iLoopVar As Long Dim DefaultPrinter As String Dim DefaultSheets As Variant Dim FirstSpace As Long Dim LastSpace As Long ' #################################################################################### ' # PROCEDURE CODE '------------------------------------------------------------------------------------- ' optimise speed Application.ScreenUpdating = False '------------------------------------------------------------------------------------- ' Print the Files in the Folder: Set LongFolder = FileSystemObj.GetFolder(LongFolderPath) '// set the folder object to the user specified folder DefaultSheets = Application.SheetsInNewWorkbook '// save default setting Application.SheetsInNewWorkbook = 1 '// create a one worksheet workbook Set ExportWB = Workbooks.Add Application.SheetsInNewWorkbook = DefaultSheets '// re-set application to default For Each LongFile In LongFolder.Files '// loop through all the files in the folder If FileSystemObj.GetExtensionName(LongFile.Path) = "xlsx" Then '// check file is an xlsx file, If InStr(1, LongFile.Name, "PipeLongSec") > 0 Then '// check file is a long section FirstSpace = InStr(1, LongFile.Name, " ") '// record position of first space character LastSpace = InStr(FirstSpace + 1, LongFile.Name, " ") '// record position of last space character Set OpenLong = Workbooks.Open(LongFile.Path) '// open the file OpenLong.Sheets("Long Sections").Copy After:=ExportWB.Sheets(ExportWB.Sheets.Count) '// copy sheet into export workbook ExportWB.Sheets(ExportWB.Sheets.Count).Name = Mid(LongFile.Name, FirstSpace + 1, LastSpace - FirstSpace - 1) '// rename sheet we just moved to its pipe number OpenLong.Close '// close the file End If End If Next '------------------------------------------------------------------------------------- ' Delete the other worksheet Application.DisplayAlerts = False ExportWB.Sheets("Sheet1").Delete Application.DisplayAlerts = True '------------------------------------------------------------------------------------- ' Send Workbook to PDF - in save location ExportWB.ExportAsFixedFormat xlTypePDF, LongFolder.Path & "\" & LongFolder.Name & " " & Replace(Date, "/", "-") ExportWB.Close SaveChanges:=False '------------------------------------------------------------------------------------- ' Re-Set Printer to Previous Settings Application.ActivePrinter = DefaultPrinter '------------------------------------------------------------------------------------- ' END PROCEDURE Application.ScreenUpdating = True Set OpenLong = Nothing Set LongFolder = Nothing Set LongFile = Nothing Set FileSystemObj = Nothing End Sub
感谢所有帮助过的人！
感谢Santosh的build议，我有迪尔方法也工作 – 不幸的是这两种方法需要23-24秒，当我应用计时器…
Sub DirPDF_Long_Sections(LongFolderPath As String) ' #################################################################################### ' # INTRO '------------------------------------------------------------------------------------- ' Purpose ' This procedure assists the user to put all long sections from a folder into one ' PDF file. This makes it convieniet to share the long sections & print them. ' ' THIS PROCEDURE USES DIR instead of FSO ' ' #################################################################################### ' # DECLAIRATIONS '------------------------------------------------------------------------------------- ' OBJECTS Dim LongFolder As String Dim LongFile As String Dim OpenLong As Workbook Dim ExportWB As Workbook 'Dim FileSystemObj As New FileSystemObject '------------------------------------------------------------------------------------- ' VARIABLES Dim count As Long Dim DefaultPrinter As String Dim DefaultSheets As Variant Dim FirstSpace As Long Dim LastSpace As Long Dim start_time, end_time ' #################################################################################### ' # PROCEDURE CODE '------------------------------------------------------------------------------------- ' optimise speed start_time = Now() Application.ScreenUpdating = False '------------------------------------------------------------------------------------- ' Print the Files in the Folder: DefaultSheets = Application.SheetsInNewWorkbook '// save default setting Application.SheetsInNewWorkbook = 1 '// create a one worksheet workbook Set ExportWB = Workbooks.Add Application.SheetsInNewWorkbook = DefaultSheets '// re-set application to default LongFile = Dir(LongFolderPath & "\*PipeLongSec*", vbNormal) While LongFile <> vbNullString '// loop through all the files in the folder '// check file is a long section FirstSpace = InStr(1, LongFile, " ") '// record position of first space character LastSpace = InStr(FirstSpace + 1, LongFile, " ") '// record position of last space character Set OpenLong = Workbooks.Open(LongFile) '// open the file OpenLong.Sheets("Long Sections").Copy After:=ExportWB.Sheets(ExportWB.Sheets.count) '// copy sheet into export workbook ExportWB.Sheets(ExportWB.Sheets.count).Name = Mid(LongFile, FirstSpace + 1, LastSpace - FirstSpace - 1) '// rename sheet we just moved to its pipe number OpenLong.Close '// close the file LongFile = Dir() Wend '------------------------------------------------------------------------------------- ' Delete the other worksheet Application.DisplayAlerts = False ExportWB.Sheets("Sheet1").Delete Application.DisplayAlerts = True '------------------------------------------------------------------------------------- ' Send Workbook to PDF - in save location ExportWB.ExportAsFixedFormat xlTypePDF, LongFolderPath & "\" & "LongSectionCollection " & Replace(Date, "/", "-") ExportWB.Close SaveChanges:=False '------------------------------------------------------------------------------------- ' Re-Set Printer to Previous Settings '##################################################################################### '# END PROCEDURE Application.ScreenUpdating = True Set OpenLong = Nothing end_time = Now() MsgBox (DateDiff("s", start_time, end_time)) End Sub