此工具是在如下场景中催生的：针对某类业务，需要针对不同客商制作带汇总情况页 & 明细页附件的函证。在函证本体的基础上，需添加前述两类PDF文件给到交付中心打印。
而项目组的Excel文档，虽然可以将不同<函证对象>的内容放入<单独工作表>并集体打印，但这样生成的PDF文件会是<一整份文档>，而非针对不同对象分别命名、存储。而使用拆分工具，将整份Excel工作簿另存为针对不同函证对象的工作簿后，仍需人工打开Excel文件，Ctrl+P打印另存PDF，这就十分消耗时间——有超过300份此类文件需要手动生成。
此解决方案使用VBA Code，让Excel自动批量打印<指定文件夹内的Excel文件>，并按照一定要求命名为独立的PDF文档，存储在一个特定文件夹中。
如下列示可直接复用的Code：
Sub PrintSheetsToPDF()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim pdfFolderPath As String
Dim folderDialog As FileDialog
Dim startColumn As String, endColumn As String
Dim printRange As String
Dim ws As Worksheet
Dim pdfFileName As String
Dim sheetIndex As Integer
' Prompt user to select the folder 弹出对话框，让用户选择一个存储着需要打印的Excel的目标文件夹
Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
With folderDialog
.Title = "Select Folder Containing Excel Files"
If .Show <> -1 Then Exit Sub ' Exit if the user cancels
folderPath = .SelectedItems(1) & "\"
End With
' Prompt user to enter the column range 确定文件路径后，让用户选择从Excel的哪一列开始打印
startColumn = InputBox("Enter the starting column (e.g., A):", "Define Print Range")
If startColumn = "" Then Exit Sub ' Exit if the user cancels
endColumn = InputBox("Enter the ending column (e.g., Z):", "Define Print Range")
If endColumn = "" Then Exit Sub ' Exit if the user cancels
printRange = startColumn & ":" & endColumn
' Create a subfolder for PDFs if it doesn't exist 在先前不存在新设输出存储文件夹时，新建一个来放置我们的输出
pdfFolderPath = folderPath & "PDFs\"
If Dir(pdfFolderPath, vbDirectory) = "" Then MkDir pdfFolderPath
' Process each Excel file in the folder 接下来，开始处理文件夹中的每一个Excel文件
fileName = Dir(folderPath & "*.xls*") ' Get the first Excel file
Do While fileName <> ""
' Open the workbook 首先打开工作簿
Set wb = Workbooks.Open(folderPath & fileName)
' Loop through only the first two sheets (if they exist) 巡视前2个工作表（这是为了项目需求设置的，附件内容仅存于此）
For sheetIndex = 1 To 2
If sheetIndex <= wb.Sheets.Count Then
Set ws = wb.Sheets(sheetIndex)
' Define the print area and set narrow margins 确定打印区域，并设置一个紧凑的页边距
With ws.PageSetup
.PrintArea = printRange
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.1)
.FooterMargin = Application.InchesToPoints(0.1)
' Focus only on the width: fit the columns to 1 page wide 设置页面使其能够在一页中涵盖所有需要的列
.Zoom = False ' Disable automatic zoom scaling
.FitToPagesWide = 1 ' Fit to 1 page wide
.FitToPagesTall = False ' Do not scale the height, let Excel handle it
' Optional: Set the page orientation to landscape if necessary 此处注释保留 如果列大于了10就采用横向列示
' If ws.UsedRange.Columns.Count > 10 Then
' .Orientation = xlLandscape
' End If
End With
' Auto-resize columns to prevent "####" from appearing 因为存在过于紧凑的单元格导致内容井号化，此处自动调整
ws.Columns.AutoFit
' Generate PDF file name 接下来即可输出PDF文件，以工作表名称命名
pdfFileName = pdfFolderPath & Left(fileName, InStrRev(fileName, ".") - 1) & "-" & Format(sheetIndex, "00") & ".pdf"
' Export the sheet to PDF 将文件另存为PDF
ws.ExportAsFixedFormat Type:=xlTypePDF, fileName:=pdfFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Next sheetIndex
' Close the workbook to release memory 关闭工作簿释放内存
wb.Close SaveChanges:=False
Set wb = Nothing
' Process the next file 处理下一份文件，最后留下一句新年快乐作为祝福（毕竟时近年关）
fileName = Dir
Loop
MsgBox "Finished & Happy New Year!", vbInformation
End Sub我们只需要随意新建一个xlsm格式的Excel，在FnLock的情况下，按住Alt+F11打开Macro对话框，将前述代码复制进去，随后保存，并按Alt+F8打开Macro菜单，点击运行之即可。
此工具可以在20分钟内批量打印300多份附件，解决了人工可能需要5-10小时(1-2min/File)才能完成的事项，且此工具可以泛用/复用，在Excel存在需要调整的内容的前提下，依旧能够批量更正、处理差错。
欢迎试用！