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

Exploring

发布于 2022-09-20 14:31:30

1.2K0

发布于 2022-09-20 14:31:30

文章背景：测试仪器的数据有些会以Excel文件的形式保存，工作量大时测试员会选中多份文件进行批量打印，同时可能需要删除一些无需打印的测试数据（比如空白样，错误数据等）。现在以批量打印Excel文件（.xlsx格式）为例，采用VBA编程，进行任务的实现。

无需打印的Excel文件名依次填在E列，打印时会跳过这些文件。

在模块中添加如下代码，批量打印文件的按钮中指定的宏命令为printFiles。

Option Explicit

Sub printFiles()

    '批量打印文件，同时剔除掉一些不需要打印的文件
    
    Application.ScreenUpdating = False
    
    '获取默认路径
    ChDrive ThisWorkbook.Worksheets("Sheet1").Range("B2").Value
    ChDir ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
    
    Dim fd As FileDialog
 
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
    Dim vrtSelectedItem As Variant, Filename As String
    
    Dim arr(), num_row As Integer, ii As Integer, flag As Integer, temp As Integer
    
    Dim Response1, Response2
    
    ThisWorkbook.Activate
    
    With fd
    
        'The user pressed the button.
        If .Show = -1 Then
        
            Response1 = MsgBox("有些文件不需要打印？", vbYesNo + vbDefaultButton1, "打印确认")
            
            '如果全部打印
            If Response1 = vbNo Then
            
                For Each vrtSelectedItem In .SelectedItems
 
                    '打印xlsx文件
                    If Right(vrtSelectedItem, 5) = ".xlsx" Then
                
                        Workbooks.Open (vrtSelectedItem)
                    
                        '打印首张sheet,打印区域已提前设置好
                        ActiveWorkbook.Sheets(1).PrintOut
                    
                        ActiveWorkbook.Close False
                    
                    End If
                
                Next vrtSelectedItem
            
            '如果需要剔除掉一些不需要打印的文件
            ElseIf Response1 = vbYes Then
            
                '计算不需要打印的文件个数
                num_row = Range("E65534").End(xlUp).Row
    
                If num_row > 1 Then
    
                    For ii = 2 To num_row
        
                        If Range("E" & ii) <> "" Then
            
                            flag = flag + 1
                
                            ReDim Preserve arr(1 To flag)
                
                            arr(flag) = Range("E" & ii).Value & ".xlsx"
                
                        Else
            
                            Exit For
            
                        End If
        
                    Next
    
                End If
                
                Response2 = MsgBox(CStr(flag) & "份文件不需要打印？", vbYesNo + vbDefaultButton1, "确认无需打印的文件个数")
                
                If Response2 = vbYes Then
                
                    For Each vrtSelectedItem In .SelectedItems
 
                        '打印xlsx文件
                        If Right(vrtSelectedItem, 5) = ".xlsx" Then
                        
                            Filename = getFileName(vrtSelectedItem)
                            temp = 0
                            
                            On Error Resume Next
                            temp = WorksheetFunction.Match(Filename, arr, 0)
                            
                            If temp <= 0 Then
                            
                                Workbooks.Open (vrtSelectedItem)
                        
                                '打印首张sheet,打印区域已提前设置好
                                ActiveWorkbook.Sheets(1).PrintOut
                    
                                ActiveWorkbook.Close False
                                
                            End If
                    
                        End If
                
                    Next vrtSelectedItem
                
                Else
                
                    Set fd = Nothing
        
                    MsgBox "待确认！"
            
                    Application.ScreenUpdating = True
            
                    Exit Sub
                
                End If
                
            End If
            
        'The user pressed Cancel.
        Else
            
            Set fd = Nothing
        
            MsgBox "没有选择任何文件！"
            
            Application.ScreenUpdating = True
            
            Exit Sub
            
        End If
        
    End With
 
    'Set the object variable to Nothing.
    Set fd = Nothing
    
    MsgBox "打印结束！"
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
End Sub

Function getFileName(path As Variant, Optional sep As String = "\") As String

    ' 提取文件名
    Dim arrSplitStrings() As String
    Dim num As Integer
    
    arrSplitStrings = Split(path, sep)
    
    num = UBound(arrSplitStrings)
    
    getFileName = arrSplitStrings(num)
    
End Function

代码运行效果：http://mpvideo.qpic.cn/0bf2ciaa2aaasiaik6tibrqfaewdbujaadia.f10002.mp4?dis_k=625f34f9de981d7fbe1d671e5c93ea1a&dis_t=1663655455&vid=wxv_1809777645945946112&format_id=10002&support_redirect=0&mmversion=false

（1）由于笔者电脑上没有连接实体打印机，默认选择的是虚拟打印机（Adobe PDF）。因此，运行上述代码后，每打印一次，就会弹出对话框，选择 PDF 文档保存的位置和文件名。

（2）实际工作当中，如果连接了实体打印机，运行上述代码后会依次打印出你所需要的文件。

相关资料：

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

[2] Excel: 提取路径中的文件名

[3] VBA：获取指定数值在指定一维数组中的位置

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

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

vba