質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.10%

VBA シートが一個しか出力されないものとしっかり結合して出力するのと分かれる

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 551

score 14

フォルダ内のエクセルファイルをPDF出力するマクロを作成しました。
出力したい条件としては、シート名にDBを含むシートは除いて、すべてをPDF出力、複数シートがある場合は結合してPDF出力
と言った作業が行いたく以下のマクロを作成しました。

Sub EXCELファイルPDF化03() 'フォルダのEXCELファイルの一括変換

    Dim Button, T, i, L As Integer
    Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, ExFileName As String

    Application.DisplayAlerts = False  '確認メッセージを無効化します。


    Button = MsgBox("EXCEファイルの一括PDF変を行いますか?", vbYesNo + vbQuestion, "確認")
    If Button = vbYes Then

            OpenExcelFileName = Application.GetOpenFilename 'ダイアログを表示取り込むフォルダーにあるファイルを選択します。

            If OpenExcelFileName <> "False" Then
                ExcelFileName = Dir(OpenExcelFileName)  '指定したファイルパスからファイル名を代入します。
                ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "")  '指定したファイルパスを指定します。(ファイルパスからファイル名を取り除く)

                MsgBox ExcelFilePath & "この選択フォルダからPDFに変換します。"
            Else
                MsgBox "キャンセルされました"
                Exit Sub  'キャンセルでプログラムを終了します。

            End If

            ExFileName = Dir(ExcelFilePath & "*.xls?")  '指定したフォルダーから一件目のEXCELファイルを指定します。


            Do While ExFileName <> ""    '読み込むファイルがなくなるまで繰り返す。

                Workbooks.Open fileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0  'EXCELファイルを読み取り専用で読み込む
                ExFileName = Left(ExFileName, InStr(ExFileName, ".") - 1) ' ファイル名から拡張子を取り除く(.xls?)
                Set wb = ActiveWorkbook

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

                'ActiveWorkbook の記述はいらなかった
                'レポートの記述にいらないスペースがあったかも

              Dim sheet_count As Integer
              sheet_count = Worksheets.Count
              Dim ArrayShName() As String
              ReDim ArrayShName(sheet_count)
              Dim mySheet As Worksheet

            On Error Resume Next 'エラー無視

            Dim k As Long
            k = 0

            Dim j As Integer
            For j = 1 To Worksheets.Count
                If Worksheets(j).Name <> "DB" Then
                    ArrayShName(k) = Worksheets(j).Name
                    k = k + 1
                End If
            Next

            Worksheets(ArrayShName).Select
                        ActiveSheet.ExportAsFixedFormat _
                            Type:=xlTypePDF, _
                            fileName:=ExcelFilePath & ExFileName, _
                            OpenAfterPublish:=True

            ActiveWindow.Close  '読み込んだファイルを閉じます。

            ExFileName = Dir() '次のファイルを指定する。

            Loop

            MsgBox "PDFファイルに一括変換しました。"
    Else
        MsgBox "処理を中断します"
    End If

    Application.DisplayAlerts = True  '確認メッセージを有効化します。

End Sub

ただ現状タイトルにも記載して重複で申し訳ないんですが、
複数シートがあるファイルをPDF出力する際シートが一つしか出力されないものと全て出力されるものと分かれてしまい
その原因がどこにあるのかわからず困っております。

調べ方であったり、ここの記述がおかしい!など手掛かりになるヒント、アドバイスを頂けると幸いです。

宜しくお願い致します。

参考記事:https://ateitexe.com/excel-vba-sheets-to-merge-pdf/

OS:macOS Catalina バージョン10.15.3
Excelバージョン: Microsoft Excel for Mac バージョン16.39

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

0

以下のように修正してうまくいきませんか?
修正前) ActiveSheet.ExportAsFixedFormat
修正後) wb.ExportAsFixedFormat

マイクロソフトのドキュメントではExportAsFixedFormatメソッドはWorkbookオブジェクトのメソッドだと書いてありました。
https://docs.microsoft.com/ja-jp/office/vba/api/excel.workbook.exportasfixedformat

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2020/08/07 17:19

    一応以下の通りコード書き換えて見たのですがインデックスの有効範囲ではないエラーが出てしまいます。
    流石にこんな単純にプラスして記述するだけではない感じでしょうか?
    的外れな回答してしまってるとは思うのですが何卒お返事頂けると幸いです!


    ```VBA

    Sub EXCELファイルPDF化03() 'フォルダのEXCELファイルの一括変換

    Dim Button, T, i, L As Integer
    Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, ExFileName As String

    Application.DisplayAlerts = False '確認メッセージを無効化します。


    Button = MsgBox("EXCEファイルの一括PDF変を行いますか?", vbYesNo + vbQuestion, "確認")
    If Button = vbYes Then

    OpenExcelFileName = Application.GetOpenFilename 'ダイアログを表示取り込むフォルダーにあるファイルを選択します。

    If OpenExcelFileName <> "False" Then
    ExcelFileName = Dir(OpenExcelFileName) '指定したファイルパスからファイル名を代入します。
    ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "") '指定したファイルパスを指定します。(ファイルパスからファイル名を取り除く)

    MsgBox ExcelFilePath & "この選択フォルダからPDFに変換します。"
    Else
    MsgBox "キャンセルされました"
    Exit Sub 'キャンセルでプログラムを終了します。

    End If

    ExFileName = Dir(ExcelFilePath & "*.xls?") '指定したフォルダーから一件目のEXCELファイルを指定します。


    Do While ExFileName <> "" '読み込むファイルがなくなるまで繰り返す。

    Workbooks.Open fileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0 'EXCELファイルを読み取り専用で読み込む
    ExFileName = Left(ExFileName, InStr(ExFileName, ".") - 1) ' ファイル名から拡張子を取り除く(.xls?)
    Set WB = ActiveWorkbook

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

    Dim sheet_count As Integer
    sheet_count = Worksheets.Count
    Dim ArrayShName() As String
    ReDim Preserve ArrayShName(sheet_count - 2)
    Dim mySheet As Worksheet

    'On Error Resume Next 'エラー無視

    Dim k As Long
    k = 0

    Dim j As Integer
    For j = 1 To Worksheets.Count
    If Worksheets(j).Name <> "DB" Then
    ArrayShName(k) = Worksheets(j).Name
    k = k + 1
    End If
    Next

    Worksheets(ArrayShName).Select
    Cells.Select
    Selection.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    fileName:=ExcelFilePath & ExFileName, _
    OpenAfterPublish:=True

    ActiveWindow.Close '読み込んだファイルを閉じます。

    ExFileName = Dir() '次のファイルを指定する。

    Loop

    MsgBox "PDFファイルに一括変換しました。"
    Else
    MsgBox "処理を中断します"
    End If

    Application.DisplayAlerts = True '確認メッセージを有効化します。

    End Sub
    ReDim ArrayShName(sheet_count - 2)を

    ReDim Preserve ArrayShName(sheet_count - 2)に書き換えました!

    キャンセル

  • 2020/08/07 17:44

    こういう考え方をしなければいけません。
    まず、0個の要素を持てる配列を宣言します。
    次に、必要になったときに要素を1つずつ追加する。

    ということは、少しだけロジックをいじらないとダメです。


    当初の質問内容から外れてきたため、
    新しく質問を立て直してはいかがでしょうか。

    プログラム全体を通してメンターになってほしいなどあれば、teratailの規約から反れてしまいますので、私のプロフィールにあるメールアドレスへご連絡いただければ対応します。

    キャンセル

  • 2020/08/07 17:55

    ご返答ありがとうございます!

    そうですね、自分の考えを整理して新たに質問を立て直して見たいと思います!
    ご指摘ありがとうございます!

    キャンセル

0

Worksheets(ArrayShName).Select

の後に、

Stop

と書いて一次停止し、
意図したシートがちゃんと選択できているか
確認してみてください。

あと、コツとしては、
単一ブックで試してみることです。
繰り返すことはコンピューターは得意ですので、
とりあえず、1つだけで試す。
上手くいきそうなら3つで試す。
その後は10個でやってみる。
その中で、うまくいくファイルとそうでないファイルの違いを
探してみてください。


追記

Stopで止めたとき、
ローカルウィンドウの
ArrayShNameの中身を確認してください。
変数名の左に「⁺」があると思うので、それをクリックで中身が展開できます。

とりあえず、
新規ブックに以下のコードを記入し、
その後テストしたいファイルを開いた後、
コードを実行してみてください。

Option Explicit

Sub test()
    Dim wb As Workbook

    Set wb = Workbooks(Workbooks.Count)     '最後に開いたブックの取得
    If MsgBox(wb.Name & "を操作します。", vbYesNo) = vbNo Then Exit Sub

    Dim v() As String
    Dim ws As Worksheet
    Dim i As Long, j As Long

    ReDim v(wb.Worksheets.Count)
    For i = 1 To wb.Worksheets.Count
        Set ws = Worksheets(i)
        If ws.Name <> "DB" Then
            v(j) = ws.Name
            j = j + 1
        End If
    Next

    If j > 1 Then
        ReDim Preserve v(j - 1)
        Debug.Print Join(v, ",")
        wb.Activate
        wb.Worksheets(v).Select
    End If
End Sub

動作確認は、
ステップインで、一行づつ実行しながら、
ローカルウィンドウで変数の中身が意図するものになっているか
確認しながら、最終的にはシートを選択するのですから、
意図した結果が、画面上に反映されているか確認してください。

やみくもに、本番コードに追記していっても、
時間がかかるばっかりかと思いますよ。
まずは、ひとつづテーマを絞って解決していって、
自信が出来たら、本番コードに追加していってみては?

参考>>
プロパティ、メソッドの探り方 マクロ記録とF1のHelpを使う

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2020/08/06 06:30

    僕のサンプルで、ステップ実行しながら、ローカルウィンドウで配列の中身と要素数を確認して見てください。
    あとは、
    動的配列変数
    preserveキーワード
    等で検索してください。

    キャンセル

  • 2020/08/06 19:56

    解決したようでなによりです。

    PDFにエクスポートしたくないシートは非表示にしておくと、
    ブック全体でエクスポートしてもPDFに含まれないようです。
    SelectしたりActiveSheetを指定したりするところがどうも引っかかってましたが、
    そうすることで、それらのキーワードを使わなくても良くなります。
    また、開いたブックは、読み取り専用で開いても普通に開いても、
    保存しないで閉じれば結果は同じです。
    参考になれば。

    キャンセル

  • 2020/08/07 10:22

    ご返答ありがとうございます!

    SelectしたりActiveSheetを指定の部分はまだ私自身も全然理解できてない部分が多いですが
    補足での情報ありがとうございます!とても参考になります!

    いつもご丁寧に対応頂き本当にありがとうございます。

    キャンセル

0

こんにちは。

    sheet_count = Worksheets.Count
      :
    For j = 1 To Worksheets.Count
        If Worksheets(j).Name <> "DB" Then
            ArrayShName(k) = Worksheets(j).Name

Worksheets を wb.Worksheets としても変わりませんか?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2020/08/05 15:02

    ブックを伴わないWorksheetsや、ブックとワークシートを伴わないRange等を使用して、想定外のシートがアクティブだったことで失敗するケースを経験したことがあるので、、、

    > なんらかの理由でシートが一つしかアクティブになってない
    それもありますし、別のブックがアクティブになっていたら、それこそ期待した結果になりませんから。

    キャンセル

  • 2020/08/06 11:10

    ちょっと気になったのでコメントです。
    > なんらかの理由でシートが一つしかアクティブになってない
    複数シートがアクティブになることはありません。
    アクティブとセレクトの違いを意識しておくのは大事です。
    https://excel-ubara.com/excelvba1/EXCELVBA327.html

    キャンセル

  • 2020/08/06 19:42

    ご返答ありがとうございます!

    シートの件詳しく返答いただきありがとうございます!
    とても参考になります!意識して勉強させていただきます。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.10%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る