優化VBA Excel打印 - 創建PDF？

我正在打印一個完整的xlsx文件的文件夾。我希望優化並使處理速度更快 - 向打印機發送20頁大約需要40秒，這是20個不同文件中的一頁。優化VBA Excel打印 - 創建PDF？

我可以先送這些頁面的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

問候，

喬

來源

2013-10-29 AverageJoe

你能避免使用'FileSystemObj'和使用' Dir'功能。如果要合併工作表並創建主文件（稍後打印），請選中此鏈接（http://stackoverflow.com/questions/17030067/consolidating-worksheets-into-one/17030835#17030835）。 – Santosh

根據我的經驗，雙面打印通常比單面打印的打印量要長。您是否建議Excel/VBA無法管理雙面打印？ – pnuts

沒有那麼多，excel無法管理雙面打印 - 它在我們的辦公室使用更少的紙張 - 更好地打印150個雙面打印頁面並將它們綁定在一本書中，以便給予我們的商人而不是單面打印的300頁。 – AverageJoe

我成功地創造了我所需要的 - 把我的所有創建的方式將工作簿合併成容易分發和打印的東西。

代碼不打印 - 創建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

謝謝大家誰幫助！

來源

2013-10-30 02:53:10 AverageJoe

由於桑托斯的暗示我有迪爾方法也在努力 - unfortuantly兩種方法當我申請定時器採取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

來源

2013-10-30 04:57:43 AverageJoe

優化VBA Excel打印 - 創建PDF？

回答

相關問題