将创建多个 PDF 的 VBA 更改为单个 PDF

Question

下面的代码非常适合创建从工作表 3 到名为“发布”的工作表的 PDF，同时忽略任何隐藏的工作表。它为每个工作表创建一个单独的 PDF。这与用户单击的形状相关联，然后系统会提示您选择一个文件夹来保存所有 PDF。

我正在尝试更改下面的代码以执行完全相同的操作，除了为工作表 3 和“发布”之间的每个可见工作表创建一个 PDF。

我一直在研究代码，想知道是否有人知道完成此操作的最佳方法？

Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long

TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF

Dim dialog As FileDialog
Dim path As String

Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.AllowMultiSelect = False
If dialog.Show = -1 Then
    path = dialog.SelectedItems(1)
    ' Begin the loop.
    For i = 3 To TabCount
    'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
        If Sheets(i).Visible <> xlSheetVisible Then
        Else
            With Sheets(i)
                Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
                'The Fname above is equaling the cells that the PDF's filename will be
                'The folder directory below is where the PDF files will be saved
                .ExportAsFixedFormat Type:=xlTypePDF, FileName:=path & "\" & Fname, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        End If
    Next i

    Call Shell("explorer.exe" & " " & path & "\", vbNormalFocus)
    'This opens the folder where the PDFs are saved
End If
End Sub

Answer 1

如果您用鼠标选择多个工作表选项卡，然后选择打印，它会将它们全部打印为一个打印作业，因此请在代码中尝试一下：

Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long
Dim aSheetnames As Variant

TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF

Dim dialog As FileDialog
Dim path As String

Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.AllowMultiSelect = False
If dialog.Show = -1 Then
    path = dialog.SelectedItems(1)
    ' Begin the loop.
    For i = 3 To TabCount
    'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
        If Sheets(i).Visible <> xlSheetVisible Then
        Else
            redim preserve aSheetnames(i-2)  'subtract 2, since i starts at 3
            asheetnames(i-2) = sheets(i).name  'build array of the sheets to print
        End If
     Next
     Fname = 'make something up here for your bulk file name
     Sheets(asheetnames).ExportAsFixedFormat Type:=xlTypePDF, FileName:=path & "\" & Fname, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End If
End Sub

注意：没有明示或暗示的保证，您可能需要进行一些调试，因为这不是我的想法，但它可能会起作用......

Answer 2

这在我的文件中适用于通过电子邮件发送可见选项卡作为 pdf 供您使用，而不同的相同适用...您不需要使用此代码进行隐藏/未隐藏

' Export activesheet as PDF
 With ActiveWorkbook
      .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile,  
              Quality:=xlQualityStandard, IncludeDocProperties:=True,     
                     IgnorePrintAreas:=False, OpenAfterPublish:=False
 End With

Answer 3

不是在循环内部导出每个工作表，而是使用Workbook.ExportAsFixedFormat 导出整个工作簿在循环外部。

使用此方法，参数From 和To 允许您选择要输出的页面。但是，您需要知道可见工作表页码的位置。它可能不一定按照他们的工作表编号，因为某些工作表可以打印成多页。通过手动将整个工作簿保存为 PDF 来查找页码。

或者，您可以继续循环并使用Adobe Acrobat SDK 合并多个 PDF。请参阅 AcroExch.AvDoc 和 AcroExch.PDDoc 对象。但是，您的 Excel 工作簿的用户需要在其计算机上安装 Adob​​e Acrobat（而不仅仅是免费的 Reader）才能在 VBA 中引用 Adob​​e API。