VBAでPDF複数指定印刷

質問がありましたので、こちらに掲載しています。

以下のコードで全シートではなく、特定の複数シートをPDF印刷することが可能です。

Public Sub ExportSelectedSheetsToPDF()

Dim wb As Workbook
Set wb = ActiveWorkbook

If wb Is Nothing Then
    MsgBox "ブックが開かれていません。", vbExclamation
    Exit Sub
End If

' --- シート選択用の配列を構築 ---
Dim sheetCount As Long
sheetCount = wb.Sheets.Count

If sheetCount = 0 Then
    MsgBox "シートがありません。", vbExclamation
    Exit Sub
End If

' シート名一覧を改行区切りで作成
Dim sheetList As String
Dim i As Long
For i = 1 To sheetCount
    sheetList = sheetList & i & ". " & wb.Sheets(i).Name & vbCrLf
Next i

' --- InputBoxで対象シート番号を入力させる ---
Dim userInput As String
userInput = InputBox( _
    "PDF出力するシートの番号をカンマ区切りで入力してください。" & vbCrLf & _
    "（例: 1,3,5）" & vbCrLf & vbCrLf & _
    "【シート一覧】" & vbCrLf & sheetList, _
    "PDF出力シート選択")

' キャンセル or 空入力
If Len(Trim(userInput)) = 0 Then
    MsgBox "キャンセルされました。", vbInformation
    Exit Sub
End If

' --- 入力をパースして対象シートを特定 ---
Dim parts() As String
parts = Split(Replace(userInput, " ", ""), ",")

Dim selectedSheets() As String
Dim selectedCount As Long
selectedCount = 0

ReDim selectedSheets(0 To UBound(parts))

Dim idx As Long
For i = 0 To UBound(parts)
    If IsNumeric(parts(i)) Then
        idx = CLng(parts(i))
        If idx >= 1 And idx <= sheetCount Then
            selectedSheets(selectedCount) = wb.Sheets(idx).Name
            selectedCount = selectedCount + 1
        Else
            MsgBox "シート番号 " & parts(i) & " は範囲外です（1?" & sheetCount & "）。", vbExclamation
            Exit Sub
        End If
    Else
        MsgBox "無効な入力: " & parts(i), vbExclamation
        Exit Sub
    End If
Next i

If selectedCount = 0 Then
    MsgBox "対象シートが選択されていません。", vbExclamation
    Exit Sub
End If

ReDim Preserve selectedSheets(0 To selectedCount - 1)

' --- 保存先をダイアログで選択 ---
Dim savePath As String
Dim defaultName As String
defaultName = Replace(wb.Name, ".xlsx", "")
defaultName = Replace(defaultName, ".xlsm", "")
defaultName = Replace(defaultName, ".xls", "")

savePath = Application.GetSaveAsFilename( _
    InitialFileName:=defaultName & ".pdf", _
    FileFilter:="PDFファイル (*.pdf), *.pdf", _
    Title:="PDF保存先を選択")

If savePath = "False" Then
    MsgBox "キャンセルされました。", vbInformation
    Exit Sub
End If

' --- 対象シートを選択状態にしてPDF出力 ---
On Error GoTo ErrHandler

' まず対象シートをまとめて選択
wb.Sheets(selectedSheets).Select

' 選択中のシートをPDFにエクスポート
ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=savePath, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

' 元のシートに戻す
wb.Sheets(1).Select

MsgBox "PDFを出力しました。" & vbCrLf & savePath, vbInformation, "完了"
Exit Sub

ErrHandler:
MsgBox "PDF出力中にエラーが発生しました。" & vbCrLf & _
"エラー番号: " & Err.Number & vbCrLf & _
"内容: " & Err.Description, vbCritical, "エラー"
wb.Sheets(1).Select

End Sub