ExcelVBA学习之一键打印文件夹中的所有Excel文件

【问题】要打印的Excel文件有几百个,格式有2003版本的也有2016版本的，全部都打印第一个sheet1工作表就可以啦,（如果所在的sheet工作都要打印呢？）。

【常规做法】“打开~打印~关闭~不保存”，再“打开~打印~关闭~不保存”，几十个文件还可以，几百个就~~~~~~~~天啊。 ==要在代码中调整文件夹版本==

Sub 批量打印()    ‘本方法不要把“控制文件.xlsm”放在要打印的文件夹里，

      Dim file$, folder$, wb As Workbook

      folder = "G:\test\" ‘在这里调整你要打印的文件夹

      file = Dir(folder & "*.xls*")

      Do While file <> ""

             Set wb = GetObject(folder & file)

             wb.Worksheets(1).PrintOut

wb.Close SaveChanges:=False

 file = Dir

 Loop

End Sub

==本方法要把主控制文件放在文件夹中==

Sub 打印()   ‘。    Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, C As String, i As Integer    'Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动    myPath = ThisWorkbook.Path & "\"     '把文件路径定义给变量    myFile = Dir(myPath & "*.xls*") '依次找寻指定路径中的*.xls文件    C = "sheet1"  ’要打印的工作表的名称    t = Timer    Do While myFile <> ""                     '当指定路径中有文件时进行循环       If myFile <> ThisWorkbook.Name Then          Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件          AK.Worksheets(1).PrintOut       '打印          Workbooks(myFile).Close False               '关闭源工作簿,并不作修改       End If       myFile = Dir                                   '找寻下一个*.xls文件    Loop    'Application.ScreenUpdating = True                 '恢复刷新屏幕    MsgBox "打印输出完毕！ 所用时间为：" & Timer - t & " 秒", 64, "提示" End Sub

=====可选择文件夹版本====

Sub p1()

    Dim lj, wb As Workbook

    Set objShell = CreateObject("Shell.Application")

    Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)

    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

        wb.Close False

        myFile = Dir

    Wend

End Sub

==每个Excel文件需要打印里面所有的sheet工作表==

Sub 打印文件夹下所有文件所有工作表() 'On Error Resume Next Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Application.ScreenUpdating = False '关闭屏幕刷新 Application.DisplayAlerts = False '关闭提示     If MsgBox("需要操作的数据表是：EXCEL2003 格式，请选择：是！" & Chr(13) & "" & Chr(13) & "需要操作的数据表是：EXCEL2007 格式，请选择：否！", vbYesNo, "提示！！") = vbYes Then        S = "\*.xls"        ss = 4     Else        S = "\*.xlsx"        ss = 5:     End If t = Timer '记录开始时间     f = Dir(ThisWorkbook.Path & S) '生成查找EXCEL的目录     n = 2 '开始记录工作簿名和工作表名的开始行     Do While f > " "   '在目录中循环         If f <> ThisWorkbook.Name Then   '如果不是打开的工作簿             Set xlBook = Workbooks.Open(ThisWorkbook.Path & "\" & f) '打开已经存在的EXCEL工件簿文件             For Each sh In xlBook.Worksheets '遍历工作表                   '    sh.PrintPreview  '打印预览,可以取消的                      sh.PrintOut Copies:=1, Collate:=True '开始打印                       Windows(ThisWorkbook.Name).Activate '回到操作主表界面             Next                Windows(f).Close (False)   '关闭工作簿，不保存          End If         f = Dir     Loop Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "一共用时：" & Timer - t & " 秒", , "提示!" End Sub