用deepseek写vba代码批量打印同一文件夹下多个excel表格

输入指令

写一段vba代码，在新建XLS工作表中对同一文件夹下面的多个excel表进行如下操作，第一个条件，删除每个excel表中的空行；第二个条件，只打印包含新建XLS工作表中第一列中关键词的工作簿；第三个条件，将第二行（索引第二行）行高设置为固定值143榜；第四个条件，如果excel表总行数超过35行，强制A3纸纵向打印，否则用A4纸横向打印，将打印A3纸的excel表放在A4纸之后打印；第五个条件，先显示打印预览，如果人判断可以继续打印，再人工按下确认键。将第一行字体设置为24磅

Sub SmartPrintWithConfirmation()
    Dim wsKey As Worksheet, KeyRange As Range
    Dim Keywords() As String, KeywordCount As Integer
    Dim FileDict As Object, FilePaths As Object
    Dim FilePath As String, FileName As String, FileList As String
    Dim wb As Workbook, PrintSheet As Worksheet
    Dim LastRow As Long, i As Long
    Dim UserConfirm As VbMsgBoxResult
    
    '初始化对象
    Set FileDict = CreateObject("Scripting.Dictionary")
    Set FilePaths = CreateObject("Scripting.Dictionary")
    
    '获取关键词列表
    Set wsKey = ThisWorkbook.Sheets("Sheet1")
    Set KeyRange = wsKey.Range("A:A").SpecialCells(xlCellTypeConstants)
    KeywordCount = KeyRange.Count
    ReDim Keywords(1 To KeywordCount)
    
    For i = 1 To KeywordCount
        Keywords(i) = Trim(KeyRange.Cells(i).Value)
    Next i
    
    '第一阶段：收集匹配文件
    FilePath = ThisWorkbook.Path & "\"
    FileName = Dir(FilePath & "*.xls*")
    
    Do While FileName <> ""
        If FileName <> ThisWorkbook.Name Then
            '关键词匹配检查
            For i = 1 To KeywordCount
                If InStr(1, FileName, Keywords(i), vbTextCompare) > 0 Then
                    '记录唯一文件名和完整路径
                    If Not FileDict.Exists(UCase(FileName)) Then
                        FileDict.Add UCase(FileName), FileName
                        FilePaths.Add FilePaths.Count, FilePath & FileName
                    End If
                    Exit For
                End If
            Next i
        End If
        FileName = Dir()
    Loop
    
    '无匹配文件处理
    If FileDict.Count = 0 Then
        MsgBox "未找到包含关键词的Excel文件", vbInformation
        Exit Sub
    End If
    
    '生成文件列表字符串
    FileList = "以下文件将被打印：" & vbCrLf & vbCrLf
    For Each Key In FileDict.Keys
        FileList = FileList & "• " & FileDict(Key) & vbCrLf
    Next
    FileList = FileList & vbCrLf & "确认继续打印吗？"
    
    '用户确认对话框
    UserConfirm = MsgBox(FileList, vbYesNo + vbInformation, "打印确认")
    If UserConfirm <> vbYes Then Exit Sub
    
    '第二阶段：处理并打印文件
    For i = 0 To FilePaths.Count - 1
        Set wb = Workbooks.Open(FilePaths(i))
        Set PrintSheet = Nothing
        
        On Error Resume Next
        Set PrintSheet = wb.Worksheets(1)
        On Error GoTo 0
        
        If Not PrintSheet Is Nothing Then
            With PrintSheet
                '删除空行
                LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                For j = LastRow To 1 Step -1
                    If Application.CountA(.Rows(j)) = 0 Then .Rows(j).Delete
                Next j
                
                '自动调整布局
                .Cells.WrapText = False
                .Columns.AutoFit
                .Rows.AutoFit
                If .Rows(2).RowHeight <> 143 Then .Rows(2).RowHeight = 143
                
                '设置第一行字体大小为24
                .Rows(1).Font.Size = 24
                
                '智能纸张选择
                LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                With .PageSetup
                    .PrintArea = ""
                    .LeftMargin = Application.InchesToPoints(0.25)
                    .RightMargin = Application.InchesToPoints(0.25)
                    .TopMargin = Application.InchesToPoints(0.25)
                    .BottomMargin = Application.InchesToPoints(0.25)
                    .FitToPagesTall = 1
                    .FitToPagesWide = 1
                    
                    If LastRow > 35 Then
                        .PaperSize = xlPaperA3
                        .Orientation = xlPortrait
                    Else
                        .PaperSize = xlPaperA4
                        .Orientation = xlLandscape
                    End If
                End With
            End With
            
            '执行打印（3份）
            wb.PrintOut Copies:=3
        End If
        wb.Close SaveChanges:=True
    Next
    
    MsgBox "打印任务已完成！" & vbCrLf & _
           "总计处理文件：" & FileDict.Count & " 个", _
           vbInformation, "完成"
End Sub