优化 VBA Excel 打印 - 创建 PDF？答案

【问题标题】：Optimise VBA Excel Printing - Create PDF?优化 VBA Excel 打印 - 创建 PDF？
【发布时间】：2013-11-09 09:10:11
【问题描述】：

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

问候，

乔

【问题讨论】：

你可以避免使用FileSystemObj而使用Dir函数。如果您想合并工作表并创建一个主文件（稍后打印），请查看此link。
并不是说 excel 无法管理双面打印 - 它在我们的办公室使用的纸张更少 - 最好打印 150 页双面打印并将它们装订成一本书送给我们的商人，而不是打印 300 页单面打印侧面。
@Santosh - 我喜欢这个链接 - 不过因为我们的组织与网络合作，而且每个用户的 excel 版本都需要这个插件，现在很难做到这一点。
很好的建议。我想我会做的是：1）将所有工作表放入一个工作簿（临时）然后导出为 PDF - 我可以让我的用户使用该 PDF 文件做他们想做的事情。经理们希望能够通过电子邮件传递管道数据，然后再选择是否要打印。
@Santosh 有没有办法可以在没有“FileSystemObj”的情况下设置文件夹对象？

标签： excel vba pdf printing

【解决方案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

感谢所有帮助过的人！

【讨论】：

【解决方案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

【讨论】：