Question

我正在打印一个充满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

此致

乔

Answer 1

我成功地创造了我所需要的东西 - 一种将我创建的所有工作簿放入易于分发和打印的东西的方法。

代码无法打印 - 改为创建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

感谢所有帮助过的人！

Answer 2

感谢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

优化VBA Excel打印 - 创建PDF？

2 个答案: