将选定的工作表导出到单独的 PDF 文件中

Question

我需要将工作簿中选定的工作表导出为单独的 PDF 文件。

下面的代码将整个选择的工作表导出到一个 PDF 中，并使用不同的工作表名称复制该 PDF。

Sub ExportAsPDF()

Dim Folder_Path As String

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder path"
    If .Show = -1 Then Folder_Path = .SelectedItems(1)
End With

If Folder_Path = "" Then Exit Sub

Dim sh As Worksheet

For Each sh In ActiveWindow.SelectedSheets
    sh.ExportAsFixedFormat xlTypePDF, Folder_Path & Application.PathSeparator & Range("RD").Text & " " & sh.Name & " 2024.pdf"
Next

MsgBox "Done"

End Sub

Answer 1

Option Explicit

Sub ExportAsPDF()

    Dim Folder_Path As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder path"
        If .Show = -1 Then Folder_Path = .SelectedItems(1)
    End With
    If Folder_Path = "" Then Exit Sub
    
    Dim sh As Worksheet, n As Long
    For Each sh In ActiveWindow.SelectedSheets
        sh.Activate
        sh.Select
        ActiveSheet.ExportAsFixedFormat xlTypePDF, _
        Folder_Path & Application.PathSeparator & Range("RD").Text & " " & sh.Name & " 2024.pdf", _
        IgnorePrintAreas:=True
        n = n + 1
    Next
    MsgBox n & " Sheets Exported"

End Sub

Answer 2

Dim sh As Worksheet
Dim selectedWorksheets As New Collection

For Each sh In ActiveWindow.SelectedSheets
    selectedWorksheets.Add sh
Next sh

For Each sh In worksheets
    sh.Select
    sh.ExportAsFixedFormat xlTypePDF, Folder_Path & Application.PathSeparator & sh.Name & " 2024.pdf"
Next sh

'// The following part resets the Selection to what it was at the start of this procedure (remove if not needed)

Dim i As Long
Dim worksheetNames As Variant

i = 1
ReDim worksheetNames(1 To selectedWorksheets.Count)

For Each sh In selectedWorksheets
    worksheetNames(i) = sh.Name
    i = i + 1
Next sh

ThisWorkbook.worksheets(worksheetNames).Select

MsgBox "Done"

End Sub