Execel VBA批量打印文件夹中的所有文件,并设置打印为一页数
【问题】
在工作中我们要打印文件夹中所有文件,如果每个文件打开--输入打印份数--打印--关闭,再来打开--输入打印份数--打印--关闭,如果文件少还可以, 如果文件多你会累S,
所以就想能不能一次打印完成。
于是想了一下,设计一个吧
本程序按键后--弹出文件夹选择框--选择文件夹--确定,就可以批量打印啦
【代码】
'------选择文件夹批量打印一式x份---------------------------
Sub 批量打印设置copies()
Dim lj, wb As Workbook
Set objShell = CreateObject("Shell.Application")
path0 = ThisWorkbook.Path & "\"
mypages = Range("B1").Value
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, path0)
If objFolder Is Nothing Then
MsgBox "未选择文件夹"
Exit Sub
End If
lj = objFolder.self.Path
If Right(lj, 1) <> "\" Then
lj = lj & "\"
End If
Set objFolder = Nothing
Set objShell = Nothing
myFile = Dir(lj & "*.xls*")
While myFile <> ""
Set wb = Workbooks.Open(lj & myFile)
wb.Worksheets(1).PrintOut Copies:=mypages
wb.Close False
myFile = Dir
Wend
End Sub
【问题】问题又来了,因为文件有多个工作表,且要求工作表所有的工作表要打印为一页数。那怎么办。
经过思考。又解决了
【代码】
Sub 设置内容打印为一页()
Dim lj, wb As Workbook, 打印页数 As Integer, this_sht As Worksheet, sh As Worksheet
Set objShell = CreateObject("Shell.Application")
path0 = ThisWorkbook.Path & "\"
mypages = Range("B1").Value
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, path0)
If objFolder Is Nothing Then
MsgBox "未选择文件夹"
Exit Sub
End If
lj = objFolder.self.Path
If Right(lj, 1) <> "\" Then
lj = lj & "\"
End If
Set objFolder = Nothing
Set objShell = Nothing
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '关闭提示
myFile = Dir(lj & "*.xls*")
While myFile <> ""
Set wb = Workbooks.Open(lj & myFile)
With wb
For Each sh In wb.Worksheets
打印页数 = sh.PageSetup.Pages.Count 'ExecuteExcel4Macro("Get.Document(50)")
' Debug.Print "打印页数="; 打印页数
If 打印页数 > 1 Then
With sh.PageSetup
.PrintArea = sh.UsedRange.Address
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
Debug.Print ".Pages.Count="; .Pages.Count
End With
End If
Next
End With
wb.Save
wb.Close
myFile = Dir
Wend
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
本程序,能不用逐个打开文件的情况下,把文件夹中的所有文件所有工作表,设置打印为一页。
只要我们把两个程序整合就一起就可以完成:批量打印文件夹中的所有文件所有工作表,按一式X份的方式打印。一键---喝杯水---等一会再来打印机处拿你要的东西。哈哈
设置前
设置后