导出文件功能

导出文件功能是一个基于 Excel/WPS VBA 的工作表选择与批量导出工具，主要用于在工作簿中自动生成“导出功能”目录页，并通过复选框选择需要导出的工作表，最后将选中的工作表复制到一个新的 .xlsx 文件中。

该功能适合用于全成本测算模板、工程清单模板、报价文件、结算资料、台账系统、多专业表格汇总文件等场景。当一个工作簿中包含大量工作表时，用户可以先生成导出目录，再勾选需要输出的工作表，一键导出为独立文件。

本版本为 3.2 导出增强版，包含自动创建导出页、批量生成复选框、多列目录布局、全选/取消全选、选中表批量复制、公式转数值、保留格式、另存为 .xlsx、状态栏进度提示、Excel/WPS 兼容优化、错误处理与环境恢复等功能，适合在正式模板中作为导出模块使用。

📌 核心功能一览

功能	说明
自动生成导出目录	运行 `GenerateSheetListWithCheckboxes` 后生成可勾选目录
自动创建导出页	如果不存在“导出功能”工作表，会自动创建
自动扫描工作表	遍历当前工作簿全部工作表
自动排除导出页	“导出功能”工作表本身不会列入导出清单
复选框选择	每个工作表名称前自动生成一个复选框
多列目录布局	每列最多 50 个工作表，超出后自动换到下一组
固定边框区域	每组目录固定 50 行，并统一设置边框
全选功能	`SelectAllExportSheets` 可一键选中全部复选框
取消全选	`UnselectAllExportSheets` 可一键取消全部选择
批量导出	`ExportSelectedSheets` 导出所有被勾选的工作表
公式转数值	导出后的文件自动将公式转换为值，保留格式
另存为 XLSX	默认保存为 `.xlsx` 文件
默认文件名	自动生成带时间戳的导出文件名
状态栏提示	生成目录、复制工作表、处理公式、保存文件时显示状态
Excel/WPS 兼容	对 WPS 环境加入 `DoEvents` 优化
错误处理完善	出错后提示错误代码与描述，并恢复应用状态

⚙️ 项目结构说明

模块组成

模块	类型	作用
Module1	标准模块	存放导出目录生成、导出文件、全选、取消全选等过程
导出功能	工作表	自动生成的导出选择目录页
生成目录按钮	表单控件/形状按钮	绑定 `GenerateSheetListWithCheckboxes`
导出按钮	表单控件/形状按钮	绑定 `ExportSelectedSheets`
全选按钮	表单控件/形状按钮	绑定 `SelectAllExportSheets`
取消全选按钮	表单控件/形状按钮	绑定 `UnselectAllExportSheets`

默认目录区域

参数	默认值	说明
导出页名称	导出功能	自动生成或使用该工作表作为导出选择页
起始行	第 5 行	工作表清单从第 5 行开始
起始列	第 2 列，即 B 列	导出目录从 B 列开始
每组最大行数	50 行	每组显示 50 个工作表
每组列数	2 列	一列复选框，一列工作表名称
导出格式	`.xlsx`	导出文件保存为 Excel 工作簿
文件格式代码	51	`xlOpenXMLWorkbook`，即 XLSX 格式

导出目录布局示意

默认从 B4:C54 开始生成第一组目录，超过 50 个工作表后自动向右扩展：

B列	C列	D列	E列	F列	G列
选择	工作表名称	选择	工作表名称	选择	工作表名称
□	表1	□	表51	□	表101
□	表2	□	表52	□	表102
…	…	…	…	…	…
□	表50	□	表100	□	表150

🚀 使用方式

第一步：打开 VBA 编辑器

在 Excel 或 WPS 表格中按下：

Alt + F11

进入 VBA 编辑器。

第二步：插入标准模块

在 VBA 编辑器中依次点击：

插入 → 模块

新建一个标准模块，例如 Module1。

第三步：粘贴完整代码

将本文下方的完整 VBA 代码复制到标准模块中。

第四步：生成导出目录

运行宏：

1	GenerateSheetListWithCheckboxes

代码会自动创建或刷新名为：

导出功能

的工作表，并列出当前工作簿中可导出的所有工作表。

第五步：勾选需要导出的工作表

在“导出功能”页中，勾选需要导出的工作表。

如果需要全部导出，可以运行：

1	SelectAllExportSheets

如果需要取消全部选择，可以运行：

1	UnselectAllExportSheets

第六步：导出选中工作表

运行宏：

1	ExportSelectedSheets

选择保存位置后，程序会将选中的工作表复制到新工作簿，并保存为 .xlsx 文件。

📋 完整代码

标准模块代码

' ==========================================
' 功能：生成导出文件用的目录表模块 + 导出文件功能模块
' 作者：XLCS-Jgwy
' 日期：2026-06-02
' 版本：3.2
' ==========================================

Option Explicit

Private Const EXPORT_SHEET_NAME As String = "导出功能"
Private Const START_ROW As Long = 5
Private Const START_COL As Long = 2
Private Const MAX_ROWS_PER_COL As Long = 50
Private Const XLSX_FILE_FORMAT As Long = 51

'========================
' 入口1：生成导出目录
'========================
Sub GenerateSheetListWithCheckboxes()

    Dim exportSheet As Worksheet
    Dim ws As Worksheet
    Dim chkBox As Object
    Dim totalSheets As Long
    Dim sheetNames() As String
    Dim i As Long
    Dim rowIndex As Long, colIndex As Long
    Dim groupIndex As Long
    Dim startTime As Double
    Dim isWps As Boolean
    Dim totalCols As Long
    Dim c As Long
    Dim maxRowsInCol As Long
    Dim colOffset As Long
    Dim lastCol As Long
    Dim lastRowOverall As Long

    Dim oldScreenUpdating As Boolean
    Dim oldEnableEvents As Boolean
    Dim oldDisplayAlerts As Boolean
    Dim oldCalculation As Long

    On Error GoTo ErrorHandler

    startTime = Timer
    isWps = IsWPSEnvironment()

    ' 保存应用状态
    oldScreenUpdating = Application.ScreenUpdating
    oldEnableEvents = Application.EnableEvents
    oldDisplayAlerts = Application.DisplayAlerts
    oldCalculation = Application.Calculation

    ' 提速
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "正在生成导出目录..."

    ' 获取或创建"导出功能"工作表
    Set exportSheet = GetOrCreateExportSheet()

    ' 清空旧内容和旧复选框（保留前3行）
    exportSheet.Rows("4:" & exportSheet.Rows.Count).Clear

    On Error Resume Next
    exportSheet.CheckBoxes.Delete
    On Error GoTo ErrorHandler

    ' 统计可导出工作表数量
    totalSheets = CountExportableSheets()

    If totalSheets = 0 Then
        MsgBox "当前工作簿没有可导出的工作表。", vbExclamation
        GoTo SafeExit
    End If

    ' 收集工作表名称
    ReDim sheetNames(1 To totalSheets)

    i = 0

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> EXPORT_SHEET_NAME Then
            i = i + 1
            sheetNames(i) = ws.Name
        End If
    Next ws

    ' 计算总列数
    totalCols = ((totalSheets - 1) \ MAX_ROWS_PER_COL) + 1

    ' 生成目录
    For i = 1 To totalSheets

        groupIndex = (i - 1) \ MAX_ROWS_PER_COL
        rowIndex = START_ROW + ((i - 1) Mod MAX_ROWS_PER_COL)
        colIndex = START_COL + groupIndex * 2

        ' 设置表头（每一列都需要设置）
        If ((i - 1) Mod MAX_ROWS_PER_COL) = 0 Then

            With exportSheet

                .Cells(START_ROW - 1, colIndex).Value = "选择"
                .Cells(START_ROW - 1, colIndex + 1).Value = "工作表名称"

                With .Range(.Cells(START_ROW - 1, colIndex), .Cells(START_ROW - 1, colIndex + 1))
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Interior.Color = RGB(188, 204, 228)
                End With

                .Columns(colIndex).ColumnWidth = 5
                .Columns(colIndex + 1).ColumnWidth = 40

            End With

        End If

        exportSheet.Rows(rowIndex).RowHeight = 20
        exportSheet.Cells(rowIndex, colIndex + 1).Value = sheetNames(i)

        With exportSheet.Cells(rowIndex, colIndex)
            Set chkBox = exportSheet.CheckBoxes.Add(.Left + 3, .Top + 2, 12, 12)
        End With

        With chkBox
            .Caption = ""
            .Value = xlOff
            .Name = "chkExport_" & CStr(i)
        End With

        If i Mod 20 = 0 Or i = totalSheets Then
            Application.StatusBar = "正在生成目录 (" & i & "/" & totalSheets & ")..."
            If isWps Then DoEvents
        End If

    Next i

    ' ===== 边框设置：为所有列的所有行添加完整边框 =====
    maxRowsInCol = MAX_ROWS_PER_COL

    For c = 0 To totalCols - 1

        colOffset = START_COL + (c * 2)

        With exportSheet.Range(exportSheet.Cells(START_ROW - 1, colOffset), exportSheet.Cells(START_ROW + maxRowsInCol - 1, colOffset))
            .Borders.LineStyle = xlContinuous
            .VerticalAlignment = xlCenter
        End With

        With exportSheet.Range(exportSheet.Cells(START_ROW - 1, colOffset + 1), exportSheet.Cells(START_ROW + maxRowsInCol - 1, colOffset + 1))
            .Borders.LineStyle = xlContinuous
            .VerticalAlignment = xlCenter
        End With

    Next c

    lastCol = START_COL + (totalCols * 2) - 1
    lastRowOverall = START_ROW + maxRowsInCol - 1

    With exportSheet.Range(exportSheet.Cells(START_ROW - 1, START_COL), exportSheet.Cells(lastRowOverall, lastCol))
        .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    End With

    MsgBox "XLCS模版导出目录完成！" & vbCrLf & _
           "共生成 " & totalSheets & " 个工作表目录" & vbCrLf & _
           "共分 " & totalCols & " 列显示" & vbCrLf & _
           "每列固定 " & MAX_ROWS_PER_COL & " 行（含边框）" & vbCrLf & _
           "耗时 " & Format(Timer - startTime, "0.00") & " 秒", vbInformation

SafeExit:
    Application.ScreenUpdating = oldScreenUpdating
    Application.EnableEvents = oldEnableEvents
    Application.DisplayAlerts = oldDisplayAlerts
    Application.Calculation = oldCalculation
    ClearStatusBar
    Exit Sub

ErrorHandler:
    MsgBox "生成目录失败：" & vbCrLf & _
           "错误代码: " & Err.Number & vbCrLf & _
           "错误描述: " & Err.Description, vbCritical
    Resume SafeExit

End Sub

'========================
' 入口2：导出选中的工作表
'========================
Sub ExportSelectedSheets()

    Dim exportSheet As Worksheet
    Dim chkBox As Object
    Dim wsName As String
    Dim selectedNames() As Variant
    Dim selectedCount As Long
    Dim i As Long
    Dim targetRow As Long
    Dim targetCol As Long
    Dim savePath As Variant
    Dim newWorkbook As Workbook
    Dim ws As Worksheet
    Dim startTime As Double
    Dim isWps As Boolean

    Dim oldScreenUpdating As Boolean
    Dim oldEnableEvents As Boolean
    Dim oldDisplayAlerts As Boolean
    Dim oldCalculation As Long

    On Error GoTo ErrorHandler

    startTime = Timer
    isWps = IsWPSEnvironment()

    oldScreenUpdating = Application.ScreenUpdating
    oldEnableEvents = Application.EnableEvents
    oldDisplayAlerts = Application.DisplayAlerts
    oldCalculation = Application.Calculation

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "正在初始化导出流程..."

    Set exportSheet = GetExportSheet()
    If exportSheet Is Nothing Then GoTo SafeExit

    selectedCount = 0

    For Each chkBox In exportSheet.CheckBoxes

        If chkBox.Value = 1 Then

            targetRow = chkBox.TopLeftCell.Row
            targetCol = chkBox.TopLeftCell.Column
            wsName = Trim$(CStr(exportSheet.Cells(targetRow, targetCol + 1).Value))

            If Len(wsName) > 0 Then
                If WorksheetExists(wsName, ThisWorkbook) Then
                    selectedCount = selectedCount + 1
                    ReDim Preserve selectedNames(1 To selectedCount)
                    selectedNames(selectedCount) = wsName
                End If
            End If

        End If

    Next chkBox

    If selectedCount = 0 Then
        MsgBox "请至少选择一个工作表！", vbExclamation
        GoTo SafeExit
    End If

    Application.StatusBar = "正在复制选中的工作表..."

    If selectedCount = 1 Then
        ThisWorkbook.Worksheets(CStr(selectedNames(1))).Copy
    Else
        ThisWorkbook.Worksheets(selectedNames).Copy
    End If

    Set newWorkbook = ActiveWorkbook

    i = 0

    For Each ws In newWorkbook.Worksheets
        i = i + 1
        UpdateStatus "正在处理公式转数值：" & ws.Name, startTime, (i / newWorkbook.Worksheets.Count) * 100, isWps
        ConvertSheetFormulasToValues ws
    Next ws

    Application.StatusBar = "请选择保存位置..."

    savePath = Application.GetSaveAsFilename( _
        InitialFileName:=GetDefaultExportFileName(), _
        FileFilter:="Excel文件 (*.xlsx), *.xlsx")

    If savePath <> False Then

        Application.StatusBar = "正在保存文件..."

        newWorkbook.SaveAs Filename:=CStr(savePath), FileFormat:=XLSX_FILE_FORMAT, CreateBackup:=False

        MsgBox "导出完成！" & vbCrLf & _
               "共导出 " & selectedCount & " 个工作表" & vbCrLf & _
               "耗时 " & Format(Timer - startTime, "0.0") & " 秒" & vbCrLf & _
               "保存位置：" & CStr(savePath), vbInformation

    Else

        MsgBox "操作已取消。", vbExclamation

    End If

    On Error Resume Next
    newWorkbook.Close SaveChanges:=False
    On Error GoTo 0

SafeExit:
    Application.ScreenUpdating = oldScreenUpdating
    Application.EnableEvents = oldEnableEvents
    Application.DisplayAlerts = oldDisplayAlerts
    Application.Calculation = oldCalculation
    ClearStatusBar
    Exit Sub

ErrorHandler:
    MsgBox "导出失败：" & vbCrLf & _
           "错误代码: " & Err.Number & vbCrLf & _
           "错误描述: " & Err.Description, vbCritical

    On Error Resume Next
    If Not newWorkbook Is Nothing Then newWorkbook.Close SaveChanges:=False
    On Error GoTo 0

    Resume SafeExit

End Sub

'========================
' 工具：获取导出功能工作表
'========================
Private Function GetExportSheet() As Worksheet

    On Error Resume Next
    Set GetExportSheet = ThisWorkbook.Worksheets(EXPORT_SHEET_NAME)
    On Error GoTo 0

    If GetExportSheet Is Nothing Then
        MsgBox "请先运行“生成工作表目录”功能！", vbExclamation
    End If

End Function

'========================
' 工具：获取或创建导出功能工作表
'========================
Private Function GetOrCreateExportSheet() As Worksheet

    Dim ws As Worksheet

    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(EXPORT_SHEET_NAME)
    On Error GoTo 0

    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        ws.Name = EXPORT_SHEET_NAME
    End If

    Set GetOrCreateExportSheet = ws

End Function

'========================
' 工具：统计可导出工作表数量
'========================
Private Function CountExportableSheets() As Long

    Dim ws As Worksheet
    Dim cnt As Long

    cnt = 0

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> EXPORT_SHEET_NAME Then
            cnt = cnt + 1
        End If
    Next ws

    CountExportableSheets = cnt

End Function

'========================
' 工具：判断工作表是否存在
'========================
Private Function WorksheetExists(ByVal wsName As String, ByVal wb As Workbook) As Boolean

    Dim ws As Worksheet

    On Error Resume Next
    Set ws = wb.Worksheets(wsName)
    WorksheetExists = Not ws Is Nothing
    Set ws = Nothing
    On Error GoTo 0

End Function

'========================
' 工具：将单个工作表中的公式转为数值
'========================
Private Sub ConvertSheetFormulasToValues(ByVal ws As Worksheet)

    Dim formulaCells As Range
    Dim area As Range

    If ws Is Nothing Then Exit Sub

    On Error Resume Next
    Set formulaCells = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    If formulaCells Is Nothing Then Exit Sub

    On Error Resume Next

    For Each area In formulaCells.Areas
        area.Value = area.Value
    Next area

    On Error GoTo 0

End Sub

'========================
' 工具：状态栏更新
'========================
Private Sub UpdateStatus(ByVal msg As String, ByVal startTime As Double, ByVal percent As Double, ByVal isWps As Boolean)

    Application.StatusBar = msg & " " & Format(percent, "0.0") & "% (" & Format(Timer - startTime, "0.0") & "秒)"

    If isWps Then DoEvents

End Sub

'========================
' 工具：默认导出文件名
'========================
Private Function GetDefaultExportFileName() As String

    Dim basePath As String

    basePath = ThisWorkbook.Path

    If Len(basePath) = 0 Then
        basePath = CurDir
    End If

    If Right$(basePath, 1) <> Application.PathSeparator Then
        basePath = basePath & Application.PathSeparator
    End If

    GetDefaultExportFileName = basePath & "导出文件_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx"

End Function

'========================
' 工具：WPS环境检测
'========================
Private Function IsWPSEnvironment() As Boolean

    Static result As Boolean
    Static isChecked As Boolean

    If Not isChecked Then
        On Error Resume Next
        result = (InStr(1, Application.Name, "WPS", vbTextCompare) > 0)
        On Error GoTo 0
        isChecked = True
    End If

    IsWPSEnvironment = result

End Function

'========================
' 入口3：全选导出目录中的复选框
'========================
Sub SelectAllExportSheets()

    Dim exportSheet As Worksheet
    Dim chkBox As Object
    Dim oldScreenUpdating As Boolean
    Dim oldEnableEvents As Boolean

    On Error GoTo ErrorHandler

    oldScreenUpdating = Application.ScreenUpdating
    oldEnableEvents = Application.EnableEvents

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set exportSheet = GetExportSheet()
    If exportSheet Is Nothing Then GoTo SafeExit

    For Each chkBox In exportSheet.CheckBoxes
        chkBox.Value = 1
    Next chkBox

    MsgBox "已全部选中。", vbInformation

SafeExit:
    Application.ScreenUpdating = oldScreenUpdating
    Application.EnableEvents = oldEnableEvents
    ClearStatusBar
    Exit Sub

ErrorHandler:
    MsgBox "全选失败：" & vbCrLf & _
           "错误代码: " & Err.Number & vbCrLf & _
           "错误描述: " & Err.Description, vbCritical
    Resume SafeExit

End Sub

'========================
' 入口4：取消全选导出目录中的复选框
'========================
Sub UnselectAllExportSheets()

    Dim exportSheet As Worksheet
    Dim chkBox As Object
    Dim oldScreenUpdating As Boolean
    Dim oldEnableEvents As Boolean

    On Error GoTo ErrorHandler

    oldScreenUpdating = Application.ScreenUpdating
    oldEnableEvents = Application.EnableEvents

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set exportSheet = GetExportSheet()
    If exportSheet Is Nothing Then GoTo SafeExit

    For Each chkBox In exportSheet.CheckBoxes
        chkBox.Value = xlOff
    Next chkBox

    MsgBox "已全部取消选中。", vbInformation

SafeExit:
    Application.ScreenUpdating = oldScreenUpdating
    Application.EnableEvents = oldEnableEvents
    ClearStatusBar
    Exit Sub

ErrorHandler:
    MsgBox "取消全选失败：" & vbCrLf & _
           "错误代码: " & Err.Number & vbCrLf & _
           "错误描述: " & Err.Description, vbCritical
    Resume SafeExit

End Sub

注意：以上代码中调用了 ClearStatusBar，如果你的工程中没有该过程，请补充以下代码：

Private Sub ClearStatusBar()
    On Error Resume Next
    Application.StatusBar = False
    On Error GoTo 0
End Sub

🔍 技术要点详解

1. 使用常量统一控制导出模块参数

代码开头通过常量统一管理导出页名称、目录起始位置、每列最大行数和导出文件格式：

Private Const EXPORT_SHEET_NAME As String = "导出功能"
Private Const START_ROW As Long = 5
Private Const START_COL As Long = 2
Private Const MAX_ROWS_PER_COL As Long = 50
Private Const XLSX_FILE_FORMAT As Long = 51

含义如下：

常量	说明
`EXPORT_SHEET_NAME`	导出功能页名称
`START_ROW`	工作表清单起始行
`START_COL`	工作表清单起始列
`MAX_ROWS_PER_COL`	每组目录最大行数
`XLSX_FILE_FORMAT`	导出文件格式，51 表示 `.xlsx`

这种写法便于后期维护，只需要修改常量即可调整整体布局和导出格式。

2. 自动获取或创建“导出功能”工作表

生成导出目录时，程序会调用：

1	Set exportSheet = GetOrCreateExportSheet()

如果当前工作簿中已存在“导出功能”工作表，则直接使用。

如果不存在，则自动在最后添加一张新工作表并命名为：

导出功能

核心逻辑为：

If ws Is Nothing Then
    Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    ws.Name = EXPORT_SHEET_NAME
End If

这样用户无需手动创建导出页，降低使用门槛。

3. 自动清理旧目录与旧复选框

每次重新生成导出目录前，代码会清空旧目录区域：

1	exportSheet.Rows("4:" & exportSheet.Rows.Count).Clear

同时删除旧复选框：

1	exportSheet.CheckBoxes.Delete

这样可以避免重复运行后出现：

旧工作表名称残留
复选框重复叠加
目录区域格式混乱
导出时读取到旧数据

4. 多列目录布局

代码按每列 50 个工作表进行分组：

1
2
3

groupIndex = (i - 1) \ MAX_ROWS_PER_COL
rowIndex = START_ROW + ((i - 1) Mod MAX_ROWS_PER_COL)
colIndex = START_COL + groupIndex * 2

生成效果为：

第 1 至第 50 个工作表显示在第 1 组
第 51 至第 100 个工作表显示在第 2 组
第 101 至第 150 个工作表显示在第 3 组
以此类推

每组两列：

1	选择 + 工作表名称

这种方式比单列显示更节省空间，尤其适合工作表数量较多的模板。

5. 自动添加复选框

每个工作表名称前会自动添加一个复选框：

1	Set chkBox = exportSheet.CheckBoxes.Add(.Left + 3, .Top + 2, 12, 12)

复选框名称按顺序生成：

1	.Name = "chkExport_" & CStr(i)

默认状态为未选中：

1	.Value = xlOff

导出时程序会遍历所有复选框，判断哪些被勾选。

6. 根据复选框位置读取工作表名称

导出过程不是依赖复选框名称，而是通过复选框所在单元格定位右侧的工作表名称：

1
2
3

targetRow = chkBox.TopLeftCell.Row
targetCol = chkBox.TopLeftCell.Column
wsName = Trim$(CStr(exportSheet.Cells(targetRow, targetCol + 1).Value))

这种设计更加灵活，只要复选框左侧布局不变，就能准确获取需要导出的工作表名称。

7. 一次性复制选中的工作表

选中的工作表名称会保存到数组中：

1 2	ReDim Preserve selectedNames(1 To selectedCount) selectedNames(selectedCount) = wsName

如果只选中一个工作表：

1	ThisWorkbook.Worksheets(CStr(selectedNames(1))).Copy

如果选中多个工作表：

1	ThisWorkbook.Worksheets(selectedNames).Copy

Excel/WPS 会自动将复制的工作表放入一个新工作簿中。

8. 公式自动转为数值

导出后，程序会遍历新工作簿中的每张工作表，将公式区域转换为数值：

1	Set formulaCells = ws.UsedRange.SpecialCells(xlCellTypeFormulas)

然后将公式单元格的值覆盖为当前计算结果：

1	area.Value = area.Value

这样导出的文件：

不依赖原工作簿公式
不暴露公式逻辑
保留当前计算结果
保留原有格式

这对于正式对外发送文件非常实用。

9. 自动生成默认导出文件名

保存时会自动生成默认文件名：

1	导出文件_yyyymmdd_hhnnss.xlsx

核心代码为：

1	GetDefaultExportFileName = basePath & "导出文件_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx"

如果当前工作簿已经保存，则默认路径为当前工作簿所在目录。

如果当前工作簿尚未保存，则使用当前工作目录。

10. 保存为 XLSX 文件

导出文件使用：

1	newWorkbook.SaveAs Filename:=CStr(savePath), FileFormat:=XLSX_FILE_FORMAT, CreateBackup:=False

其中：

1	Private Const XLSX_FILE_FORMAT As Long = 51

表示保存为 .xlsx 格式。

导出的 .xlsx 文件不包含宏，更适合发送给外部用户。

11. 全选与取消全选

全选过程：

1	Sub SelectAllExportSheets()

会将“导出功能”页中所有复选框设置为选中：

1	chkBox.Value = 1

取消全选过程：

1	Sub UnselectAllExportSheets()

会将所有复选框设置为未选中：

1	chkBox.Value = xlOff

这两个入口适合绑定到“全选”和“取消全选”按钮上，提高操作效率。

12. 状态栏进度提示与 WPS 适配

在生成目录和导出过程中，代码使用状态栏显示处理进度：

1	Application.StatusBar = "正在生成导出目录..."

处理公式时会显示百分比和耗时：

1	Application.StatusBar = msg & " " & Format(percent, "0.0") & "% (" & Format(Timer - startTime, "0.0") & "秒)"

针对 WPS 环境，代码加入：

1	If isWps Then DoEvents

可以在大量工作表处理时提升界面响应性，减少“假死”感。

📊 相比普通导出代码的优化改进

优化项	普通代码	本版本
工作表选择	手动输入名称或固定导出	复选框勾选，直观方便
导出目录	无目录或手动维护	自动生成导出目录
导出页	需手动创建	自动创建“导出功能”页
多表导出	循环逐个复制较繁琐	支持一次性复制选中工作表
公式处理	公式可能保留并失效	自动转为数值，保留格式
文件格式	可能保存为含宏格式	默认导出为 `.xlsx`
选择效率	一个个勾选费时	支持全选、取消全选
多工作表布局	单列显示过长	每 50 个自动换列
旧控件清理	容易重复生成复选框	每次生成前删除旧复选框
状态提示	无进度反馈	状态栏显示进度和耗时
WPS 兼容	大量操作时易卡顿	WPS 环境中适当 `DoEvents`
错误处理	出错后环境可能不恢复	统一错误处理并恢复应用状态
用户体验	操作步骤不清晰	生成目录、勾选、导出流程明确

💡 可自定义参数

修改导出功能页名称

默认导出页名称为：

1	Private Const EXPORT_SHEET_NAME As String = "导出功能"

如果希望改为“文件导出”，可以修改为：

1	Private Const EXPORT_SHEET_NAME As String = "文件导出"

修改目录起始位置

默认从 B5 开始生成工作表清单：

1 2	Private Const START_ROW As Long = 5 Private Const START_COL As Long = 2

如果希望从 D6 开始，可以修改为：

1 2	Private Const START_ROW As Long = 6 Private Const START_COL As Long = 4

修改每列显示数量

默认每列显示 50 个工作表：

1	Private Const MAX_ROWS_PER_COL As Long = 50

如果希望每列显示 40 个，可以改为：

1	Private Const MAX_ROWS_PER_COL As Long = 40

如果工作表非常多，也可以设置为 60 或 80。

修改导出文件格式

当前导出格式为 .xlsx：

1	Private Const XLSX_FILE_FORMAT As Long = 51

如果需要导出为 .xlsm，可改用：

1	Private Const XLSX_FILE_FORMAT As Long = 52

并同步修改保存筛选器：

1	FileFilter:="启用宏的Excel文件 (.xlsm), .xlsm"

不过对外发布时，通常建议使用 .xlsx，避免宏安全提示。

修改默认导出文件名

当前默认文件名为：

1	导出文件_yyyymmdd_hhnnss.xlsx

对应代码：

1	GetDefaultExportFileName = basePath & "导出文件_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx"

可以改为：

1	GetDefaultExportFileName = basePath & "XLCS导出_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx"

🛠️ 按钮设置建议

建议在“导出功能”工作表顶部放置 4 个按钮。

按钮文字	绑定宏	作用
生成导出目录	`GenerateSheetListWithCheckboxes`	生成或刷新工作表清单
全选	`SelectAllExportSheets`	勾选全部工作表
取消全选	`UnselectAllExportSheets`	取消全部勾选
导出选中工作表	`ExportSelectedSheets`	导出被勾选的工作表

表单按钮推荐命名

按钮名称	建议用途
btnGenerateExportList	生成导出目录
btnExportSelected	导出选中表
btnSelectAllExport	全选
btnUnselectAllExport	取消全选
btnXLCSExport	XLCS导出按钮

虽然代码不依赖按钮名称，但规范命名有利于后期维护。

📐 推荐布局方式

位置	说明
导出功能页顶部	放置“生成目录、全选、取消全选、导出”按钮
B列开始	默认复选框目录区域
每组两列	一列选择，一列工作表名称
冻结前几行	按钮区域固定显示，便于操作
顶部增加说明	提醒用户先生成目录，再勾选导出

⚠️ 注意事项

当前代码默认导出功能页名称为 导出功能。
“导出功能”工作表不会被列入导出清单。
运行 GenerateSheetListWithCheckboxes 会清除“导出功能”页第 4 行及以下内容。
如果“导出功能”页中第 4 行以下有重要内容，请先备份或调整起始行。
导出前必须先运行 GenerateSheetListWithCheckboxes 生成目录。
导出时至少需要勾选一个工作表，否则会提示“请至少选择一个工作表”。
导出的工作簿会将公式转为数值，但保留原格式。
导出文件默认为 .xlsx，不会保留 VBA 代码。
如果源工作表包含外部链接、数据连接、透视表等内容，导出后建议检查结果。
如果源工作表中有保护、隐藏区域或特殊对象，导出后可能需要人工核对。
WPS 中复选框和另存为行为可能与 Excel 略有差异，建议正式使用前测试。
如果代码提示 Sub 或 Function 未定义：ClearStatusBar，请补充文中给出的 ClearStatusBar 过程。

📦 常见问题

Q1：为什么提示“请先运行生成工作表目录功能”？

原因是当前工作簿中没有名为：

导出功能

的工作表。

解决方法：

先运行：

1	GenerateSheetListWithCheckboxes

程序会自动创建并生成导出目录。

Q2：为什么没有可导出的工作表？

如果当前工作簿中只有“导出功能”一张工作表，则没有其他可导出的工作表，程序会提示：

1	当前工作簿没有可导出的工作表。

请确认工作簿中存在其他业务工作表。

Q3：为什么点击导出后提示“请至少选择一个工作表”？

原因是没有勾选任何复选框。

请在“导出功能”页中勾选需要导出的工作表，或运行：

1	SelectAllExportSheets

先全部选中。

Q4：导出的文件为什么没有公式？

这是正常设计。

本功能会将导出文件中的公式转为数值：

1	area.Value = area.Value

目的是防止导出文件依赖原模板公式，同时避免公式泄露。

Q5：可以保留公式导出吗？

可以。

如果希望保留公式，可在 ExportSelectedSheets 中注释或删除以下代码段：

For Each ws In newWorkbook.Worksheets
    i = i + 1
    UpdateStatus "正在处理公式转数值：" & ws.Name, startTime, (i / newWorkbook.Worksheets.Count) * 100, isWps
    ConvertSheetFormulasToValues ws
Next ws

这样导出的工作表会保留原公式。

Q6：隐藏工作表会不会被列入导出清单？

会。

当前代码遍历的是：

1	ThisWorkbook.Worksheets

没有判断工作表是否隐藏。

如果需要排除隐藏表，可以在统计和收集工作表名称时增加判断：

1	If ws.Name <> EXPORT_SHEET_NAME And ws.Visible = xlSheetVisible Then

Q7：导出的文件可以改为 PDF 吗？

当前代码导出的是 Excel 文件。

如果需要导出 PDF，需要改用：

1	ExportAsFixedFormat

可以扩展为“勾选工作表后批量导出 PDF”。

Q8：WPS 表格可以用吗？

通常可以使用。

本版本已经加入 WPS 环境检测：

1	IsWPSEnvironment()

并在批量操作时使用：

1	If isWps Then DoEvents

但不同 WPS 版本对复选框控件、工作表复制、另存为行为支持存在差异，建议在实际环境中测试。

💡 扩展方向

方向	说明
排除隐藏表	只显示可见工作表
分类导出	按专业、阶段、表类型分组显示
导出 PDF	支持选中表批量导出为 PDF
保留公式开关	增加复选项，选择是否公式转数值
仅导出值和格式	移除公式、名称、链接等敏感信息
自动添加封面	导出文件中自动加入封面或说明页
默认勾选规则	根据工作表名称自动勾选指定表
导出前检查	检查空表、保护表、隐藏表、外部链接
导出日志	记录导出时间、导出人、导出表名、保存路径
自定义文件名	增加输入框，让用户输入导出文件名
多格式导出	支持 `.xlsx`、`.xlsm`、`.pdf` 等格式
一键生成并导出	将生成目录和导出流程合并为一键操作

📋 排除隐藏工作表示例

如果希望隐藏工作表不显示在导出目录中，需要在统计和收集工作表名称的地方增加可见性判断。

示例：

If ws.Name <> EXPORT_SHEET_NAME Then
    If ws.Visible = xlSheetVisible Then
        cnt = cnt + 1
    End If
End If

收集工作表名称时也应同步加入：

If ws.Name <> EXPORT_SHEET_NAME Then
    If ws.Visible = xlSheetVisible Then
        i = i + 1
        sheetNames(i) = ws.Name
    End If
End If

这样只有可见工作表会进入导出清单。

📋 保留公式导出思路

如果某些场景下需要保留公式，可以增加一个开关常量：

1	Private Const CONVERT_FORMULAS_TO_VALUES As Boolean = True

然后在导出过程中改为：

If CONVERT_FORMULAS_TO_VALUES Then
    For Each ws In newWorkbook.Worksheets
        ConvertSheetFormulasToValues ws
    Next ws
End If

当需要保留公式时，将常量改为：

1	Private Const CONVERT_FORMULAS_TO_VALUES As Boolean = False

即可。

📋 批量导出 PDF 思路

如果需要将选中的工作表导出为 PDF，可以在复制工作表到新工作簿后，使用：

newWorkbook.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="导出文件.pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

该方式适合正式成果文件、报审资料、打印版文件输出。