一键批量导出Excel为PDF！两种模式满足你99%的转换需求

开篇

不知道你有没有遇到过这种情况：

月底做报表，十多个工作表要分别转成PDF发给不同部门；领导给了一个工作簿，里面几十份工作表要全部转成PDF归档；明明只是简单的转换工作，却要你对着Excel点几十次「另存为」→「选择PDF格式」→「保存」，点鼠标点到手指抽筋，还很容易漏存、错存...

更坑的是，网上很多在线转换工具要么限速、要么有水印，文件大一点还不让用，敏感数据传到第三方网站也不安全。

今天就给大家分享一个我一直在用的VBA工具，一键批量导出Excel为PDF，还支持两种模式：既能把当前工作簿的工作表批量导出到一个pdf中，也能按照不同工作表导出到不同的pdf中，完全免费无广告，本地运行安全又高效！

先看视屏

解决方案

这个工具的核心思路其实很简单，利用Excel自带的PDF导出功能，通过VBA实现批量自动化操作，不需要依赖任何第三方软件：

1. 先选择PDF保存位置，不用你手动一步步点保存
2. 自动处理文件名的非法字符，避免因为名称问题导出失败
3. 导出完成自动弹框提示，还告诉你一共转了多少个pdf、花了多长时间

两种模式覆盖绝大多数场景：

• ✅ 模式1：处理当前打开的Excel，支持所有工作表合并成一个PDF或者「每个工作表单独导出PDF」
• ✅ 模式2：处理当前打开的Excel，每个工作表单独导出PDF

代码实现

核心功能说明

这个VBA代码一共实现了这几个实用功能：

1. 两种导出模式自由选择，满足不同场景需求
2. 自动清理文件名里的非法字符，避免导出失败
3. 运行时自动优化Excel速度，导出完成后恢复原有设置
4. 完善的错误提示，出问题了也能知道哪里错了

📝 完整代码如下：

Option Explicit

' 主程序：仅当前工作簿批量导出PDF
Sub 批量导出PDF()
    Dim savePath As String
    Dim exportCount As Long
    Dim startTime As Single
    Dim scrUpd As Boolean, calcMod As XlCalculation

    On Error GoTo ErrDeal
    startTime = Timer
    scrUpd = Application.ScreenUpdating
    calcMod = Application.Calculation

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.StatusBar = "正在准备导出PDF..."

    ' 选择PDF保存文件夹
    savePath = 选择文件夹("请选择PDF保存的文件夹")
    If savePath = "" Then GoTo ResetApp
    If Right(savePath, 1) <> "\" Then savePath = savePath & "\"

    ' 执行当前工作簿导出
    exportCount = 导出当前簿PDF(savePath)

    MsgBox "PDF导出完成！" & vbCrLf & vbCrLf & _
           "共导出：" & exportCount & " 个PDF文件" & vbCrLf & _
           "耗时：" & Format(Timer - startTime, "0.00") & " 秒", vbInformation

ResetApp:
    ' 强制解除工作表组合选中，杜绝残留错乱
    ThisWorkbook.Sheets(1).Select
    Application.ScreenUpdating = scrUpd
    Application.Calculation = calcMod
    Application.DisplayAlerts = True
    Application.StatusBar = False
    Exit Sub

ErrDeal:
    MsgBox "导出过程中出现错误：" & vbCrLf & Err.Description, vbCritical
    Resume ResetApp
End Sub

' ========== 核心：当前工作簿｜合并1个PDF / 分表单独PDF ==========
Private Function 导出当前簿PDF(savePath As String) As Long
    Dim ws As Worksheet
    Dim isMerge As Integer
    Dim fileName As String
    Dim shtNameArr() As String
    Dim i As Integer, cnt As Integer

    isMerge = MsgBox("是否将所有工作表合并为1个PDF？" & vbCrLf & "否 = 每个工作表单独生成PDF", vbYesNo + vbQuestion, "导出选项")

    If isMerge = vbYes Then
        ' 合并导出：所有可见工作表合成一个PDF
        cnt = 0
        ReDim shtNameArr(1 To ThisWorkbook.Sheets.count)
        For Each ws In ThisWorkbook.Sheets
            If ws.Visible = xlSheetVisible Then
                cnt = cnt + 1
                shtNameArr(cnt) = ws.Name
            End If
        Next ws
        ReDim Preserve shtNameArr(1 To cnt)

        ThisWorkbook.Sheets(shtNameArr).Select
        fileName = 过滤非法字符(ThisWorkbook.Name) & ".pdf"

        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            fileName:=savePath & fileName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

        导出当前簿PDF = 1
    Else
        ' 分开导出：每张工作表独立PDF
        cnt = 0
        For Each ws In ThisWorkbook.Sheets
            If ws.Visible = xlSheetVisible Then
                fileName = 过滤非法字符(ThisWorkbook.Name & "_" & ws.Name) & ".pdf"
                Application.StatusBar = "正在导出：" & ws.Name

                ws.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    fileName:=savePath & fileName, _
                    Quality:=xlQualityStandard, _
                    OpenAfterPublish:=False
                cnt = cnt + 1
            End If
        Next ws
        导出当前簿PDF = cnt
    End If
End Function

'===== 工具：选择保存文件夹 =====
Private Function 选择文件夹(tit As String) As String
    Dim dlg As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    dlg.title = tit
    If dlg.Show = -1 Then
        选择文件夹 = dlg.SelectedItems(1)
    Else
        选择文件夹 = ""
    End If
    Set dlg = Nothing
End Function

'===== 工具：清理文件名非法字符 =====
Private Function 过滤非法字符(s As String) As String
    Dim arr, i
    arr = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    For Each i In arr
        s = Replace(s, i, "_")
    Next
    过滤非法字符 = Left(s, 180)
End Function

代码解析

给新手朋友说几个关键的细节：

1. 速度优化：代码一开始就关闭了屏幕更新和自动计算，批量导出的时候Excel不会闪，速度也快很多，导出完成后自动恢复原来的设置，不影响你后续使用
2. 自动去非法字符：很多人手动导出的时候经常遇到因为工作表名有/\:*?"<>|这些符号导致导出失败，这个代码会自动把这些符号换成下划线，直接就能导出成功

使用步骤

新手朋友按照下面的步骤操作就行，非常简单：

1. 打开Excel，启用开发工具

• 如果你的Excel左上角看不到「开发工具」选项卡，可以百度搜「Excel 启用开发工具」，一分钟就能开好

2. 打开VBA编辑器

• 按快捷键 Alt + F11 就能直接打开

3. 插入模块

• 在左侧右键点击你的工作簿名称 → 选择「插入」→ 选择「模块」

4. 粘贴代码

• 把上面的所有代码完整复制粘贴到右边的代码窗口中

5. 运行代码

• 点击工具栏上的「运行」按钮（就是那个绿色的小三角），或者按快捷键 F5

6. 跟着提示操作

• 选择PDF要保存到哪个文件夹
• 会问你要不要合并所有工作表成一个PDF，根据需要选就好
• 等个几秒钟，就导出完成了！

注意事项

1. 兼容性：Excel 2010及以上版本可以直接用，Excel 2007需要安装微软官方的PDF导出插件才能用，现在基本上都是2010以上的版本了，不用担心
2. ** PDF格式**：导出用的是标准的PDF格式，质量是最高的，和你手动另存为的效果一样
3. 打印区域：代码默认会保留你在Excel里设置的打印区域，导出的PDF分页和你Excel设置的一样，提前设置好打印页边距就行
4. 启用宏：保存文件的时候需要保存为「启用宏的工作簿(*.xlsm)」格式，下次打开的时候记得要启用宏才能正常运行

结语

有了这个工具，以后不管是转10个还是100个Excel工作表，都是一键搞定，再也不用手动重复操作了，节省出来的时间喝杯奶茶不好吗😉

如果你经常需要处理PDF转换，这个工具一定要收藏起来，下次用的时候直接拿出来用就行。

🔔 关注公众号「宏蜘蛛」，获取更多实用Excel自动化工具，帮你10分钟搞定一天的工作！