VBA: 多份Excel文件的批量顺序打印（3）

Exploring

发布于 2024-04-22 11:00:44

1010

发布于 2024-04-22 11:00:44

文章背景： 上一篇文章（参见文末的参考资料[1]）提到，可以通过VBA编程，选中需要打印的多份Excel文件，进行批量打印。最近发现，有一台电脑更换主机后，通过宏命令打印时，仍然出现了出纸乱序的问题。

打印顺序乱的原因可能是，文件对话框中选择的文件列表的顺序与实际打开文件的顺序不一致。在代码中，我们使用了.SelectedItems属性来获取用户选择的文件列表，然后使用循环遍历这个列表。然而，在某些情况下，文件对话框可能会以不同的顺序显示文件列表，导致实际打开文件的顺序与用户希望的顺序不一致。

为了解决这个问题，下面尝试将文件列表按照文件名（数字大小）进行排序，然后再进行打印操作。

VBA代码如下：

Option Explicit

Option Base 1
' 消息框，无需手动点击关闭Declare PtrSafe Function MessageBoxTimeout Lib "user32" _    Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, _                                ByVal lpText As String, _                                ByVal lpCaption As String, _                                ByVal wType As Long, _                                ByVal wlange As Long, _                                ByVal dwTimeout As Long) As Long
Sub PrintSelectedFiles()

    '按文件名称（数字大小）的顺序打印


    Dim fd As FileDialog
    Dim strFilePath As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim fileList() As Variant
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    '获取默认路径
    ChDrive ThisWorkbook.Worksheets("报告").Range("B3").Value2
    ChDir ThisWorkbook.Worksheets("报告").Range("B4").Value2

    ' 创建一个文件对话框对象
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    ' 设置文件对话框的属性
    With fd
    
        .AllowMultiSelect = True
        
        .Title = "请选择需要打印的Excel文件！"
        
        .Filters.Clear
        
        '.Filters.Add "Excel文件", "*.xls; *.xlsx"
        .Filters.Add "Excel文件", "*.xls"

        ' 显示文件对话框，如果用户点击了“确定”，则执行后续操作
        If .Show = -1 Then
        
            ' 将文件列表存储到数组中
            ReDim fileList(1 To .SelectedItems.Count)
            
            For i = 1 To .SelectedItems.Count
            
                fileList(i) = .SelectedItems(i)
                
            Next i

            ' 对文件列表进行排序
            Call QuickSort(fileList, LBound(fileList), UBound(fileList))
             
            ' 遍历排序后的文件列表
            
            For i = LBound(fileList) To UBound(fileList)
            
                ' 打开选定的文件
                strFilePath = fileList(i)
                
                Set wb = Workbooks.Open(strFilePath)

                ' 获取第一个工作表
                Set ws = wb.Worksheets(1)

                ' 打印当前工作表
                ws.PrintOut

                ' 关闭工作簿，不保存更改
                wb.Close SaveChanges:=False
                
            Next i
            
        Else
        
            Set fd = Nothing
        
            'MsgBox "没有选择任何文件！"
            MessageBoxTimeout 0, "没有选择任何文件！", "打印报告", 0, 0, 1000
            
            Application.ScreenUpdating = True
            
            Exit Sub
            
        End If
        
    End With
    
    'Set the object variable to Nothing.
    
    Set fd = Nothing
    
    'MsgBox "打印结束！"
    MessageBoxTimeout 0, "打印结束！", "打印报告", 0, 0, 2000
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
End Sub

' 快速排序算法（用于对文件列表进行排序）
Sub QuickSort(arr As Variant, ByVal first As Long, ByVal last As Long)

    Dim pivot As Variant, temp As Variant
    
    Dim i As Long, j As Long

    If first < last Then
    
        'Initial
        pivot = arr(first)
        
        i = first
        
        j = last

        While i < j
        
            While Val(arr(j)) >= Val(pivot) And j > first
            
                j = j - 1
                
            Wend

            While Val(arr(i)) <= Val(pivot) And i < last
            
                i = i + 1
                
            Wend

            If i < j Then
            
                temp = arr(i)
                
                arr(i) = arr(j)
                
                arr(j) = temp
                
                j = j - 1
                
                i = i + 1
                
            End If
            
        Wend

        arr(first) = arr(j)
        
        arr(j) = pivot

        QuickSort arr, first, j - 1
        
        QuickSort arr, j + 1, last
        
    End If
    
End Sub

（1）文件名称默认以数字命名，如1.xls, 2.xls...。

（2）通过文件对话框，选择多份Excel文件（.xls格式），进行批量顺序打印。

参考资料：

[1] VBA: 多份Excel文件的批量顺序打印

[2] VBA: 多份文件的批量顺序打印（2）

[3] VBA: 快速排序算法：从原理到实现

[4] 讯飞星火大语言模型

本文参与?腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2024-04-16，如有侵权请联系?cloudcommunity@tencent.com 删除

排序算法