Excel VBA 複数ｼｰﾄの偶数・奇数ページのみPDF出力したいです

Question

Excel VBA 複数ｼｰﾄの偶数・奇数ページのみPDF出力したいです

VBA初心者です。
PCはWindowsを使用しております。

Excelで選択中の複数ｼｰﾄにおいて、
偶数・奇数ページのみまとめて1つのPDFとして出力をしたいと考えております。
イメージとしては1ｼｰﾄに表が2つあり、
表1(1ページ)表2(2ページ)となっており、
同じ形式のｼｰﾄが複数ある状態です。
選択中の複数ｼｰﾄの表1だけをまとめて1つのPDF出力、
同様に表2だけをまとめて1つのPDF出力、
といった感じでマクロを作成したいです。
自分でも調べて何度も試しましたがうまくいかないので、
どなたかご教授いただけると大変助かります。

試したコードを下記に記載いたします。

どうか宜しくお願いいたします。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Dim xTotalPages As Long
Dim xStartPage As String
Dim xPage As Integer, xYesorNo
Application.ScreenUpdating = False
xStartPage = InputBox("Enter 1 for Odd, 2 for Even", "Kutools for Excel")
If xStartPage = "" Then Exit Sub
xTotalPages = ActiveSheet.PageSetup.Pages.Count
xYesorNo = MsgBox("Are you sure to print?", vbYesNo, "Kutools for Excel")
If xYesorNo = vbYes Then
  For xPage = Int(xStartPage) To xTotalPages Step 2
    ActiveSheet.PrintOut from:=xPage, To:=xPage
  Next
Else
  Exit Sub
End If
Application.ScreenUpdating = True
End Sub

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

補足です。
上記のコードで1ｼｰﾄのみの1ﾍﾟｰｼﾞのみPDF出力、2ﾍﾟｰｼﾞのみPDF出力は出来たのですが、
それを複数シートまとめて出力することが出来ない状況です。
宜しくお願いいたします。

Answer 1

複数シートを対象にする場合、PrintOutメソッドの対象がActiveSheetだとダメですね。
以下でどうでしょう？
対象が"Sheet1", "Sheet2", "Sheet3"の3つのシートだとしています。

Sub PrintData()
    Dim xTotalPages As Long
    Dim xStartPage As String
    Dim xPage As Integer, xYesorNo
    Application.ScreenUpdating = False
    xStartPage = InputBox("Enter 1 for Odd, 2 for Even", "Kutools for Excel")
    If xStartPage = "" Then Exit Sub
    Dim TargetSheet As Variant
    TargetSheet = Array("Sheet1", "Sheet2", "Sheet3")
    Dim i As Long
    For i = LBound(TargetSheet) To UBound(TargetSheet)
        xTotalPages = xTotalPages + Worksheets(TargetSheet(i)).PageSetup.Pages.Count
    Next
    xYesorNo = MsgBox("Are you sure to print?", vbYesNo, "Kutools for Excel")
    If xYesorNo = vbYes Then
        For xPage = Int(xStartPage) To xTotalPages Step 2
            Worksheets(TargetSheet).PrintOut From:=xPage, To:=xPage
        Next
    Else
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

Comments

[N_Y_]

hex309様
ご回答いただき誠に有り難うございます。
シート名に関してですが、
こちらのExcelブックがシートの形式は同じですが、
異なるプロジェクトごとに表の内容を変えて使用するものでして、
シート名もプロジェクトによって変える仕様となっております。
また複数ｼｰﾄのｼｰﾄ数もその都度違うため、
シート名指定ではなく、
複数選択中のアクティブシートのみを出力の対象にしたいと考えております。
こういった場合の解決策はございますでしょうか。
注文が多く誠に申し訳ございません。
大変恐れ入りますが、宜しくお願いいたします。

[hex309]

だとすると、
選択去れているシートは「ActiveWindow.SelectedSheets」で取得できるので。こうですかね。

Sub PrintData2()
Dim xTotalPages As Long
Dim xStartPage As String
Dim xPage As Integer, xYesorNo
Application.ScreenUpdating = False
xStartPage = InputBox("Enter 1 for Odd, 2 for Even", "Kutools for Excel")
If xStartPage = "" Then Exit Sub

Dim sh As Worksheet
For Each sh In ActiveWindow.SelectedSheets
xTotalPages = xTotalPages + sh.PageSetup.Pages.Count
Next
xYesorNo = MsgBox("Are you sure to print?", vbYesNo, "Kutools for Excel")
If xYesorNo = vbYes Then
For xPage = Int(xStartPage) To xTotalPages Step 2
ActiveWindow.SelectedSheets.PrintOut From:=xPage, To:=xPage
Next
Else
Exit Sub
End If
Application.ScreenUpdating = True
End Sub

[hex309]

ちなみに、「アクティブシート」はシートを複数選択していても1つしかありません。細かいことですけど。
この場合は単に選択されたすべてのシートが対象ということかと。

[N_Y_]

hex309様
ご回答ありがとうございます。
「アクティブシート」の件、私の知識不足でございました。
大変失礼いたしました。
ご教授いただいたコードでマクロを実行してみたところ、
1ページのみ、2ページのみで分けることが出来ました！
本当にありがとうございます。
ただ、私が元々試していたコードが悪いのですが、
こちらのコードだと出力が印刷になってしまいます。
本来はPDF化を考えていたもので、
大変恐縮ではございますが、
PDF化にするためにはどの部分を変える必要がありますでしょうか。
お暇な時で構いませんので、ご教示いただけると助かります。
宜しくお願いいたします。

[hex309]

「1ﾍﾟｰｼﾞのみPDF出力、2ﾍﾟｰｼﾞのみPDF出力は出来たのですが」と書かれているのですから、PDF出力の方法はわかるのですよね。
そのコードを提示いただければ。

[hex309]

あと、確認ですけれど、例えば、3つのシートを選択して、奇数ページを指定した場合は、「1,3,5」ページがPDFファイルになると思うのですが、これって、1ファイルにすることを想定されていますか？

[N_Y_]

hex309様
ご返信ありがとうございます。
質問内で記載したコードはPDF出力ではなく印刷のコードでした。
私の勘違いでした。申し訳ございません。
PDF出力をした時のコードと組み合わせてなんとか自分でも試してみようと思います。

ページに関しましては、hex309様の仰る通り3つのシートで奇数ページ指定の場合は「1,3,5」ページを一つのPDFファイルにしたいと考えております。

[hex309]

1ファイルとなると、私の知る限りではアプローチをかえなくてはならないかもしれません。
ExcelだとWordのように飛び飛びのページを対象に指定できないので、別途印刷用のシートを用意して、選択されたシートのデータを一旦、そのシートに貼り付けて、PDFに出力する、という感じでしょうか。

[N_Y_]

hex309様
お世話になっております。
色々と試してみましたが、やはりできませんでした。。
Excelでは飛び飛びのページを対象に出来ないようですね。
教えていただいたのにも関わらず解決することが出来ず申し訳ございませんでした。
本当にありがとうございました。