使用豆包写一段打印含有特定关键词的多个工作表的vba代码

要求

写一段vba代码，要求如下，第一，打印同一文件夹下的多个excel公布簿的第一个工作表，第二，只打印包含新建 XLS 工作表中A列关键词的工作表簿；第三，A4纸，横向打印，水平居中；第四，首次打印前显示不重复的工作簿名称供用户确认，用户确认后才继续打印。第五，新建 XLS 工作表和需要打印的excel表格位于同一个文件夹中。第六，打印出工作表中的所有文字；第七，对齐方式为水平居中对齐

Sub PrintMatchingWorkbooks()
    Dim keyWordsRange As Range
    Dim keyWords() As String
    Dim i As Long, j As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim filePath As String
    Dim folderPath As String
    Dim workbooksToPrint() As String
    Dim numWorkbooksToPrint As Long
    Dim userConfirmation As VbMsgBoxResult
    Dim printMessage As String
    
    ' 获取当前活动工作簿的路径作为文件夹路径
    folderPath = ThisWorkbook.Path & "\"
    
    ' 获取关键词列表
    On Error Resume Next
    Set keyWordsRange = ThisWorkbook.Sheets(1).Range("A:A").SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    
    If keyWordsRange Is Nothing Then
        MsgBox "新建 XLS 工作表的 A 列未找到常量值，请检查。", vbExclamation, "错误"
        Exit Sub
    End If
    
    ReDim keyWords(1 To keyWordsRange.Cells.Count)
    For i = 1 To keyWordsRange.Cells.Count
        keyWords(i) = keyWordsRange.Cells(i).Value
    Next i
    
    ' 遍历文件夹中的所有 Excel 文件
    filePath = Dir(folderPath & "*.xls*")
    Do While filePath <> ""
        If filePath <> ThisWorkbook.Name Then
            For j = LBound(keyWords) To UBound(keyWords)
                If InStr(1, filePath, keyWords(j), vbTextCompare) > 0 Then
                    numWorkbooksToPrint = numWorkbooksToPrint + 1
                    ReDim Preserve workbooksToPrint(1 To numWorkbooksToPrint)
                    workbooksToPrint(numWorkbooksToPrint) = filePath
                    Exit For
                End If
            Next j
        End If
        filePath = Dir
    Loop
    
    ' 显示要打印的工作簿名称供用户确认
    If numWorkbooksToPrint > 0 Then
        printMessage = "以下工作簿将被打印，请确认：" & vbCrLf
        For i = 1 To numWorkbooksToPrint
            printMessage = printMessage & workbooksToPrint(i) & vbCrLf
        Next i
        userConfirmation = MsgBox(printMessage, vbYesNo, "确认打印")
        
        If userConfirmation = vbYes Then
            ' 用户确认后开始打印
            For i = 1 To numWorkbooksToPrint
                On Error Resume Next
                Set wb = Workbooks.Open(folderPath & workbooksToPrint(i))
                On Error GoTo 0
                
                If wb Is Nothing Then
                    MsgBox "无法打开工作簿: " & workbooksToPrint(i), vbExclamation, "错误"
                    GoTo NextWorkbook
                End If
                
                Set ws = wb.Sheets(1)
                
                ' 确保所有文字都显示出来
                On Error Resume Next
                ws.Cells.EntireColumn.AutoFit
                ws.Cells.EntireRow.AutoFit
                On Error GoTo 0
                
                ' 设置打印参数
                On Error Resume Next
                With ws.PageSetup
                   .Orientation = xlLandscape
                   .PaperSize = xlPaperA4
                   .CenterHorizontally = True ' 确保水平居中对齐
                   .Zoom = False
                   .FitToPagesWide = 1
                   .FitToPagesTall = False
                End With
                On Error GoTo 0
                
                ' 打印工作表
                On Error Resume Next
                ws.PrintOut
                On Error GoTo 0
                
NextWorkbook:
                If Not wb Is Nothing Then
                    wb.Close SaveChanges:=False
                End If
            Next i
        End If
    Else
        MsgBox "未找到包含关键词的工作簿。", vbInformation, "提示"
    End If
End Sub