我正在打印一个充满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
此致
乔
答案 0 :(得分：0)
我成功地创造了我所需要的东西 - 一种将我创建的所有工作簿放入易于分发和打印的东西的方法。
代码无法打印 - 改为创建PDF：
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
感谢所有帮助过的人！
答案 1 :(得分：0)
感谢Santosh建议我也使用Dir方法 - 不幸的是，当我应用计时器时，这两种方法都需要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