Excel VBA循环导出PDF仅保留最后一次结果问题求助

你的代码每次循环执行ActiveSheet.ExportAsFixedFormat时，未指定唯一输出文件名，导致每次生成的PDF都会覆盖上一次的结果，最终只保留最后一次循环的内容。而且Excel原生的ExportAsFixedFormat方法不支持直接向已存在的PDF追加页面。

无需额外软件，先把每次循环生成的Sheet2内容复制到临时工作表，最后将整个临时表导出为PDF，每个循环内容自动单独占一页。

修改后的代码：

Private Sub CommandButton1_Click()
    Dim tempSheet As Worksheet
    Dim x As Integer
    
    ' 创建临时工作表
    Set tempSheet = ThisWorkbook.Worksheets.Add
    tempSheet.Name = "TempPDF"
    
    x = 1
    Do While Sheets("Sheet2").Range("T" & x).Value <> ""
        ' 更新Sheet2的F3、F4单元格值
        Sheets("Sheet2").Range("F4").Value = Sheets("Sheet2").Range("T" & x).Value
        Sheets("Sheet2").Range("F3").Value = Sheets("Sheet2").Range("U" & x).Value
        
        ' 复制Sheet2的内容到临时表（可根据实际需求调整复制范围）
        Sheets("Sheet2").UsedRange.Copy
        tempSheet.Range("A" & tempSheet.Cells(Rows.Count, 1).End(xlUp).Row + 2).PasteSpecial xlPasteAll
        
        ' 插入分页符，确保每个循环内容单独一页
        tempSheet.Rows(tempSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1).PageBreak = xlPageBreakManual
        
        x = x + 1
    Loop
    
    ' 导出临时工作表为PDF
    tempSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\合并结果.pdf"
    
    ' 删除临时工作表
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
    ' 清除剪贴板状态
    Application.CutCopyMode = False
End Sub

如果需要先保留每次循环的独立PDF再合并，可借助Acrobat的API实现。注意要先在VBA编辑器的「工具-引用」中勾选对应版本的Adobe Acrobat xx.x Type Library。

代码示例：

Private Sub CommandButton1_Click()
    Dim x As Integer
    Dim acroApp As AcroApp
    Dim acroPDDoc As AcroPDDoc
    Dim tempPDDoc As AcroPDDoc
    Dim tempPath As String
    Dim savePath As String
    
    tempPath = ThisWorkbook.Path & "\TempPDFs\"
    savePath = ThisWorkbook.Path & "\合并结果.pdf"
    
    ' 创建临时文件夹存储单个PDF
    If Dir(tempPath, vbDirectory) = "" Then MkDir tempPath
    
    ' 初始化Acrobat应用
    Set acroApp = CreateObject("AcroExch.App")
    Set acroPDDoc = CreateObject("AcroExch.PDDoc")
    
    x = 1
    Do While Sheets("Sheet2").Range("T" & x).Value <> ""
        ' 更新Sheet2的F3、F4单元格值
        Sheets("Sheet2").Range("F4").Value = Sheets("Sheet2").Range("T" & x).Value
        Sheets("Sheet2").Range("F3").Value = Sheets("Sheet2").Range("U" & x).Value
        
        ' 导出当前内容为临时PDF
        Dim tempPDFName As String
        tempPDFName = tempPath & "单页_" & x & ".pdf"
        Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempPDFName
        
        ' 合并到主PDF文件
        If x = 1 Then
            acroPDDoc.Open tempPDFName
        Else
            Set tempPDDoc = CreateObject("AcroExch.PDDoc")
            tempPDDoc.Open tempPDFName
            acroPDDoc.InsertPages acroPDDoc.GetNumPages - 1, tempPDDoc, 0, tempPDDoc.GetNumPages, True
            tempPDDoc.Close
            Set tempPDDoc = Nothing
        End If
        
        x = x + 1
    Loop
    
    ' 保存并关闭合并后的PDF
    acroPDDoc.Save PDSaveFull, savePath
    acroPDDoc.Close
    Set acroPDDoc = Nothing
    acroApp.Exit
    Set acroApp = Nothing
    
    ' 删除临时PDF文件及文件夹
    Dim tempFile As String
    tempFile = Dir(tempPath & "*.pdf")
    Do While tempFile <> ""
        Kill tempPath & tempFile
        tempFile = Dir
    Loop
    RmDir tempPath
End Sub

• 方案一中，可根据实际打印需求调整复制的单元格范围，避免内容分页异常。
• 方案二中必须安装Adobe Acrobat（不是免费的Reader版本），否则无法调用合并API。

内容的提问来源于stack exchange，提问作者Jrisebo