VBA批量打印同一文件夹下的Excel文件!!注意：只能打已经设置好打印范围的Excel文件！！如果想打印任意数据区域请自行增加！！

---

Sub 批量打印()

Application.ScreenUpdating = False

Dim currentFileName As String

Dim myPath As String

Dim myFileName As String

Dim myFileFullName As String

Dim myWork As Object

Dim mySheet As Object

On Error Resume Next

currentFileName = Application.ActiveWorkbook.Name

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = "C:\Users\" & Environ("username") & "\Desktop\"

If .Show = True Then myPath = .SelectedItems(1) & "\"

End With

myFileName = Dir(myPath)

If myFileName = "" Then

MsgBox "该文件夹下没有可打印的文件！"

Application.ScreenUpdating = True

Exit Sub

End If

Do While Len(myFileName) > 0

If myFileName <> currentFileName Then

If Right(myFileName, 3) = "xls" Or Right(myFileName, 4) = "xlsx" Then

myFileFullName = myPath & myFileName

Set myWork = GetObject(myFileFullName)

Set mySheet = myWork.Worksheets("料单") 'sheet表名称

Set mySheet1 = myWork.Worksheets("五金") 'sheet表名称

Application.PrintCommunication = False '停止打印机通信

mySheet.PageSetup.FitToPagesWide = 1 '设置列压缩

mySheet1.PageSetup.FitToPagesWide = 1

Application.PrintCommunication = True

mySheet.PrintOut '打印输出

mySheet1.PrintOut

myWork.Close saveChanges:=False

End If

End If

myFileName = Dir()

Loop

MsgBox "所有文件已经全部传输到打印机中！" & vbCrLf & "请耐心等待......"

Application.ScreenUpdating = True

End Sub

---