通过 VBA 代码将多张工作表导出为 .pdf

Posted 2023-02-19

【中文标题】通过 VBA 代码将多张工作表导出为 .pdf

【英文标题】：Exporting multiple sheets to .pdf via VBA code

【发布时间】：2017-05-14 17:13:59

【问题描述】：

我已经看到了这个问题，但它并没有完全回答我的问题 - excel vba not exporting pagesetup to pdf correctly

在使用代码创建 .pdf 输出时，我遇到了相同的问题，即每个工作表中的指定范围没有被导出。每个工作表上的所有内容都被导出，因此每个工作表都分布在两个或多个页面上。每张纸的打印范围设置为将指定区域打印到一张纸上。

我已尝试调整链接中的代码，但它似乎不适用于多张工作表。

我试图以未经调整的形式使用的代码

Sub ClientPDFOutput()

If Sheets("File Data").Range("FD_FileName") = "" Then
'   MsgBox ("Save the file before exporting to a .pdf fomrat"), vbInformation, "Save File"

'   Exit Sub
   Else
End If

ActiveSheet.Unprotect Password:=strPassword

Range("UI_Status") = "Creating client PDF output - Please wait"

SelectSheets

Application.ScreenUpdating = False

Sheets(arrSheets).Select

strFilename = "Test"

Selection.ExportAsFixedFormat _
   Type:=xlTypePDF, _
   filename:=ActiveWorkbook.Path & "\" & strFilename & ".pdf", _
   Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, _
   IgnorePrintAreas:=True, _
   OpenAfterPublish:=False

Sheets("User Input").Select

Range("UI_Status") = "Client .pdf output created and saved"

ActiveSheet.Protect Password:=strPassword

Application.ScreenUpdating = True

MsgBox ("The client output in .pdf format has been created and saved"), vbInformation, ".pdf Created"

End Sub

与

Sub SelectSheets()

Dim rngSheets As Range

Set rngSheets = Sheets("File Data").Range("D_OutputSheets")

If rngSheets.Count = 1 Then
   arrSheets = rngSheets.Value2
   Else
   arrSheets = Application.Transpose(rngSheets.Value2)
End If

End Sub

经过更多试验后，我确定我在每一页上的打印范围都已关闭，因此更正了这些。

我添加了代码以在所有工作表都被选为工作表数组的一部分之前选择每个工作表的打印范围，但是数组的第一个工作表中的打印范围在所有工作表中都被复制。因此，如果工作表 1 中的范围是 B4:P61，工作表 2 的打印范围是 B4:M48，那么当工作表数组被选中时，工作表 2 将选择 B4:P61。

这会打印出所选范围，这对于工作表 1 是正确的，但对于其余工作表是错误的。

当我通过选择所有工作表、文件、导出手动执行此操作时，所有工作表打印范围都会被导出，那么为什么当它被记录并放入例程时它被忽略了？

【参考方案1】：

请尝试更改IgnorePrintAreas 属性。

Selection.ExportAsFixedFormat _
   Type:=xlTypePDF, _
   filename:=ActiveWorkbook.Path & "\" & strFilename & ".pdf", _
   Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, _
   IgnorePrintAreas:=False, _
   OpenAfterPublish:=False

【参考方案2】：

我建议使用以下方法来确保您的页面设置将其修复为单个页面：

With ActiveSheet.PageSetup
 .FitToPagesWide = 1
 .FitToPagesTall = 1
End With

删除 with 语句中的第一行或第二行以满足您的喜好，或保留两者。

我还看到你有selection.ExportAsFixedFormat。确保您选择的区域正确或使用固定范围。您可能还想动态确定最远的行/列并将其添加到变量PrintRange。 Getting the actual usedrange。 设置IgnorePrintAreas:=False

Dim PrintRange As Range

Set PrintRange = Range("A1:XX100")

PrintRange.ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=Filename, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False

【参考方案3】：

尝试添加一个“对于 activeworkbook 中的每个工作表”（它对我有用）：

Sub Extract_pdfs()

Dim wb As Workbook
Dim sh As Worksheet

Set wb = ThisWorkbook

For Each sh In wb.Worksheets

    sh.Select

    pdf_name = sh.Name & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ActiveWorkbook.Path & pdf_name, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

Next

End Sub

【参考方案4】：

如果您尝试将多张纸上的多个范围打印到一个 pdf 中，您可以尝试使用联合函数来组合它们，但是我没有任何运气使用联合，所以我做了一些更长的方法那。本质上，我创建了一个新页面并将范围复制到其中（以我想要的格式）我确保在之后删除该页面，因为它使再次运行宏变得更加容易。

t= 1
ThisWorkbook.Sheets.Add.Name = "Print"

set rowcount = range(tocopy).row.count

Range(tocopy).SpecialCells(xlCellTypeVisible).Copy
With Sheets("Print").Cells(t, 1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValuesAndNumberFormats
End With
t = t + rowcount

'keep doing for all ranges

Sheets("Print").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Name.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

然后我继续这样做，直到我在页面上拥有所有范围并将页面导出为 pdf。然后删除工作表“打印”。

但是，如果您只是想在单独的页面上打印每个，您可以尝试

dim printing() as string

printing(1) = "Range1"
printing(2) = "Range2"

for each section in printing
Range(section).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Name.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
next section

正如我上面提到的，你可以尝试为它设置一个联合函数（如果你的运气比我好的话）

dim printing as range 

printing = union(range1,range2,range3)

printing.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Name.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

祝你好运！希望这会有所帮助，还要注意代码可能不完全正确，因为它未经测试！