Q&A
ファイル名は40個とも全て違いますか？
指定したフォルダ内のエクセルファイルをPDF出力するマクロを作成したのですが、全てのエクセルファイルがPDF出力されません。
以下作成したマクロ
VBA
1 2 3Sub EXCELファイルPDF化03() 'フォルダのEXCELファイルの一括変換 4 5 Dim Button, T, I, L As Integer 6 Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, ExFileName As String 7 8 Application.DisplayAlerts = False '確認メッセージを無効化します。 9 10 11 Button = MsgBox("EXCEファイルの一括PDF変を行いますか？", vbYesNo + vbQuestion, "確認") 12 If Button = vbYes Then 13 14 OpenExcelFileName = Application.GetOpenFilename 'ダイアログを表示取り込むフォルダーにあるファイルを選択します。 15 16 If OpenExcelFileName <> "False" Then 17 ExcelFileName = Dir(OpenExcelFileName) '指定したファイルパスからファイル名を代入します。 18 ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "") '指定したファイルパスを指定します。（ファイルパスからファイル名を取り除く） 19 MsgBox ExcelFilePath & "この選択フォルダからPDFに変換します。" 20 Else 21 MsgBox "キャンセルされました" 22 Exit Sub 'キャンセルでプログラムを終了します。 23 24 End If 25 26 ExFileName = Dir(ExcelFilePath & "*.xls?") '指定したフォルダーから一件目のEXCELファイルを指定します。 27 28 29 30 Do While ExFileName <> "" '読み込むファイルがなくなるまで繰り返す。 31 32 Workbooks.Open fileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0 'EXCELファイルを読み取り専用で読み込む 33 ExFileName = Left(ExFileName, InStr(ExFileName, ".") - 1) ' ファイル名から拡張子を取り除く（.xls?） 34 35 With ActiveSheet.PageSetup 36 .Zoom = False 37 .FitToPagesWide = 1 38 .FitToPagesTall = 1 39 End With 40 41 'ActiveWorkbook の記述はいらなかった 42 'レポートの記述にいらないスペースがあったかも 43 Dim ws As Worksheet 44 45 On Error Resume Next 'エラー無視 46 Set ws = Worksheets("レポート") 47 On Error GoTo 0 'エラー無視解除 48 If ws Is Nothing Then '"レポート"シートが存在しなければ、 49 Worksheets(Array("表紙", "検索", "表示箇所", "行動", "順位")).Select 50 ActiveSheet.ExportAsFixedFormat _ 51 Type:=xlTypePDF, _ 52 fileName:=ExcelFilePath & ExFileName, _ 53 OpenAfterPublish:=True 54 Else 55 ws.ExportAsFixedFormat _ 56 Type:=xlTypePDF, _ 57 fileName:=ExcelFilePath & ExFileName, _ 58 OpenAfterPublish:=True 59 End If 60 61 62 ActiveWindow.Close '読み込んだファイルを閉じます。 63 64 ExFileName = Dir() '次のファイルを指定する。 65 66 Loop 67 68 MsgBox "PDFファイルに一括変換しました。" 69 Else 70 MsgBox "処理を中断します" 71 End If 72 73 Application.DisplayAlerts = True '確認メッセージを有効化します。 74 75End Sub
現状、例として４０個エクセルファイルがあると１３個しかPDF出力できない状態となっております。
Debug.PrintでExFileNameを見にいくとしっかりと４０個ファイルを見てくれているのですが、何故か全てPDF出力されてくれません。
指定したフォルダのファイル指定がおかしいのかとも思ったのですが全然わからずに手詰まりの状態です。
ここは見てみた？こうゆう風に調べてみては？等何かとっかかりになるヒント、アドバイス等頂けると幸いです！
宜しくお願い致します。
ご返答ありがとうございます！
はい、ファイル名は全て違います！
>OpenAfterPublish:=True
OpenAfterPublish:=false
にするとどうなりますか？
ご返答ありがとうございます！
以下のように追記してみましたが全てPDF出力できなかったです。
Sub EXCELファイルPDF化03() 'フォルダのEXCELファイルの一括変換
Dim Button, T, i, L As Integer
Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, ExFileName As String
OpenAfterPublish = True
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 <> "" '読み込むファイルがなくなるまで繰り返す。
Debug.Print ExFileName
Workbooks.Open fileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0 'EXCELファイルを読み取り専用で読み込む
ExFileName = Left(ExFileName, InStr(ExFileName, ".") - 1) ' ファイル名から拡張子を取り除く（.xls?）
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'ActiveWorkbook の記述はいらなかった
'レポートの記述にいらないスペースがあったかも
Dim ws As Worksheet
On Error Resume Next 'エラー無視
Set ws = Worksheets("レポート")
On Error GoTo 0 'エラー無視解除
If ws Is Nothing Then '"レポート"シートが存在しなければ、
Worksheets(Array("表紙", "検索", "表示箇所", "行動", "順位")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=ExcelFilePath & ExFileName, _
OpenAfterPublish:=True
Else
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=ExcelFilePath & ExFileName, _
OpenAfterPublish:=True
End If
ActiveWindow.Close '読み込んだファイルを閉じます。
ExFileName = Dir() '次のファイルを指定する。
Loop
MsgBox "PDFファイルに一括変換しました。"
Else
MsgBox "処理を中断します"
End If
OpenAfterPublish = False
Application.DisplayAlerts = True '確認メッセージを有効化します。
End Sub
現象としては、「フォルダ内のエクセルファイル全てPDF出力されない」ではなく、「フォルダー内のエクセルファイルの中にPDF出力されないものがある（４０ファイル中の２７ファイルが出力されない）」という事なのですね。
PDFに出力されるファイルと、PDFに出力されないファイルに、何か違いがあって、それがPDFに出力されるか否かを決定しているように思われます。その４０個のエクセルファイルは、どのようにして作られたのですか？ファイルの内容の差異は確認されましたか？
質問者が持っているファイルに依存した問題だとすると、回答者がファイルの情報を知りようがないので、回答は困難だと思います。（mako1972さんは、質問者からファイルを貰い受けて動作確認したのですか？）
印刷されない２７個のエクセルファイルにも、"レポート"."表紙", "検索", "表示箇所", "行動", もしくは"順位"というワークシート名のワークシートが１つは含まれていることを確認しましたか？
「現状、例として」と曖昧な表現をされていますが、PDF出力されるエクセルファイルが無い（皆無）なのか、PDF出力されないエクセルファイルが混ざっているなのかを明確にしてください！
ご回答ありがとうございます！
曖昧な表現をしてしまい申し訳ありません。
PDF出力されないエクセルファイルが混ざっております。
ただレポートのシートだけ出力したいエクセルファイルと表紙", "検索", "表示箇所", "行動", "順位"だけ出力したいエクセルファイルに分けてマクロを実行したところ無事全てPDFと出力されているので困っております。
そしてシートの条件が一致していないエクセルファイルが混在しているフォルダでマクロを実行するとPDF出力されないエクセルファイルが混ざってしまう状態です。
回答4件
0
新規ブックで、シートを一つにして以下をお試しください。
ExcelVBA
1Sub test() 2 Dim ws As Worksheet 3 Dim i As Long 4 5 For i = 1 To 2 6 7 'Set ws = Nothing '★変数の初期化 8 On Error Resume Next 9 Set ws = Worksheets(i) 10 On Error GoTo 0 11 12 If ws Is Nothing Then 13 MsgBox "シートがありません。" 14 Else 15 MsgBox ws.Name 16 End If 17 18 Next 19End Sub
シートの2つ目はないので、
「シートがありません。」と表示したいのですが、
2回目のループでも1つ目のシート名が表示されると思います。
なぜか？変数の初期化がなされてないからです。
on error resume next
で、エラーを無視して次の行へ進めるようにできますが、
エラーで変数の中身を初期化してくれるわけではありません。
その前に代入されたものがそのまま残ってます。
ループ内で変数を使いまわす場合は、
変数の初期化をする必要があります。
初期化の位置は、変数の用がいったん終わって、
次に代入するまでのどこでもいいです。
投稿2020/08/04 07:01
総合スコア2136
ご回答ありがとうございます！
参考のコード試させて頂き解説と解説読ませて頂くととてもわかりやすいです！
細かな説明とコードまで、なにから何まで本当にありがとうございます！とても勉強になります。
こう言ったところからじっくり理解を深めていきたいと思います。
ありがとうございます！！
0
30個くらいのファイル数で試してみましたが実行に問題なかったですね・・。
ただしWindows10 64 bit 20GのメモリのPCで、ファイルの内容はほとんどない状態です。
投稿2020/08/01 08:32
編集2020/08/01 08:35
総合スコア383
ご回答ありがとうございます！
なるほど....
一応編集されてるところ恐縮なのですが、'On Error Resume Nextと 'On Error GoTo 0をコメントアウトして実行してみたところ、実行時エラー９インデックスが有効範囲にありませんとのエラーが出ます。
そこですか。
そこはシートがなかったら無視するという
意味ですので
処理上問題無しとして
スルーしました。
ネットでもサンプルがありましたので。
それよりもエラーに
なる意味が検証出来なくています。
ご返答ありがとうございます！
投稿させてもらったコードではエラーは出ずPDFとして出力はされるんですが、フォルダ内全てのエクセルファイルがPDF出力されない状態でございます。
一応レポートのシートだけ出力したいエクセルファイルと表紙", "検索", "表示箇所", "行動", "順位"だけ出力したいエクセルファイルに分けてマクロを実行したところ無事全てPDFと出力されたので分岐の部分の文法が何か間違っているのかなと悩んでおります。
30個のファイルで1個だけ
レポートシートがない状態で
実験しましたが
問題ありませんでした。
なんとなくですがEXCELファイルは
閉じるんですが
ｐｄｆファイルを作るごとに
windowsではpdfのタブ30個分あり自動で
閉じないままでいます。
分けると上手く行く
というのがわからないところですね。
13個のレポートシートがあるとか
ないとかで止まるシート数があえばですけど。
他の方がご指摘されている通りです。
成功した13個にレポートシートがあるのか、ないのか。
20個にしたらすべて実行されるのか。
"表紙", "検索", "表示箇所", "行動"は必ずすべてのシートに存在しているのか。
などなど、現象として調べることはいろいろありそうですね。
ご返答ありがとうございます！
成功した１３個にはレポートシートも"表紙", "検索", "表示箇所", "行動", "順位"のシートもあります。
ただ全部PDF出力されず、フォルダを分けると全てPDF出力されるようになります。
データ便でUPできますか？？
UP期間は１時間とか短くてもいいです。
はまっているのはわかっているので実データで検証するか否かです。
他の方がいうように。情報が不足しています。
ご回答ありがとうございます！
すいません、データ社外秘なのでUPできないです。申し訳ないです。
親身になって教えて頂いてるのに大変申し訳ないです。
確かにエクセルファイルに何か問題があるかも等情報不足ですよね.....
もう少し他の方から頂いたアドバイスも含め検証を続けてみようと思います！
わかりました
では40個のEXCELを準備して
レポートシートがあるケースと
それ以外の事例に分けて準備して下さい。
そして
各シートのa1セルにシート名を入力してください。
データはそれで十分でしょ。
そしてマクロを実行して40個作成出来るか
確認したらよろしいと思いますよ。
ファイルの内容なんてどうでもいいのでからね。
デバッグの方法を示しているだけで
こういう方法で考えるんだよーつうね。
そういうのを検証してくれというね。
まわりくどい助言となり。。。
その上で
データが重いせいだとか
色々とプログラムを最適にしていくというね。
他の方のレスもそういう投稿者さんしな
知らない情報を開示してほしい。
そこを指摘してましたよー。
回答はしなくて大丈夫です。
ご返答ありがとうございます！
自分のコメントへの返信の未熟さもご指摘頂きありがとうございます。
デバッグの方法も試させて頂きます。
いつも勉強させて頂きありがとうございます！！
取り消します。
0
自己解決
皆様ご丁寧に回答頂きありがとうございます！
レポートを読みにいくif文をIf ws Is Nothing Thenから以下の記述に変更したところ
無事全てPDF出力されました。
If ws <> "" Then
正直、何故これで成功したのかはわからずではあるのですが、もっと検証を重ねて精進して行きたいと思います。
皆様本当に細かくアドバイス頂きありがとうございました！
投稿2020/08/03 08:39
総合スコア14
あああ
変数の初期化をしないとだめですね。
ActiveWindow.Close
set ws = Nothing
的なことをしないと、だめですね。
ご返答ありがとうございます！
頂いたコードを試させて頂きました！
毎回マクロを閉じ？ないと動作やパソコンが重くなってしまうから
変数の初期化をしないといけないと言うことでしょうか？
的外れなこと言ってたらすいません！宜しくお願い致します。
違いますね。
ちょっと別途サンプル書きます。
0
ExcelVBA
1Option Explicit 2 3Sub testメイン() 4 Dim sFolder As String 5 Dim sFile As String 6 7 'フォルダーの選択 8 If GetFolderPath(sFolder) = False Then 9 MsgBox "キャンセル" 10 Exit Sub 11 End If 12 13 'フォルダー内のエクセルファイルに対して繰り返し処理 14 sFile = Dir(sFolder & "*.xls?") 15 Do While Len(sFile) > 0 16 Export2PDF sFolder & "\" & sFile 17 sFile = Dir() 18 Loop 19End Sub 20 21Private Sub Export2PDF(ByVal sFilePath As String) 22 Dim wb As Workbook: Set wb = Workbooks.Open(sFilePath) 23 Dim v As Variant 24 Dim sExName As String 25 Dim flg As Boolean 26 Dim n As Long 27 Dim t As Single 28 29 v = "レポート" 30 On Error GoTo ErrHandler 31 wb.Worksheets(v).Select 32 On Error GoTo 0 33 34 sExName = GetExFileName(wb.FullName) 35 With ActiveSheet 36 With .PageSetup 37 .Zoom = False 38 .FitToPagesWide = 1 39 .FitToPagesTall = 1 40 End With 41 42 t = Timer 43 Do Until t + 2 < Timer 44 DoEvents 45 DoEvents 46 Loop 47 48 .ExportAsFixedFormat xlTypePDF, sExName, , , , , , True 49 End With 50 51 wb.Close False 52 Exit Sub 53 54ErrHandler: 55 If flg = False Then 56 v = Array("表示", "検索", "表示箇所", "行動", "順位") 57 flg = True 58 Resume 59 End If 60End Sub 61 62Private Function GetFolderPath(ByRef sPath As String) As Boolean 63 With Application.FileDialog(msoFileDialogFolderPicker) 64 .InitialFileName = ThisWorkbook.Path 65 .AllowMultiSelect = False 66 .Title = "フォルダの選択" 67 If .Show = True Then 68 sPath = .SelectedItems(1) 69 GetFolderPath = True 70 End If 71 End With 72End Function 73 74Private Function GetExFileName(ByVal sPath As String) As String 75 GetExFileName = Left(sPath, InStrRev(sPath, ".")) & "pdf" 76End Function
ちょっと、↑これで試してみてもらえます？
要はページセットアップのあと、
2秒待ってみようということです。
ページ設定は手動でも重い処理なので、
怪しいかなと。
多分その記述を追加してから挙動がおかしいのでは？
あと、ページ設定がちゃんとできているかの確認もお願いします。
グループ化したシートを、
ActiveSheetと指定したことがないので、
怖いです。が、うまいテストデータもないので山勘です＾＾；
そこでないなら、少しファイル数を減らして、
ステップインで画面を確認しながら動作確認願います。
ちゃんと出力できてないのは、
どこかの処理が重くて命令をすっ飛ばされてるような気がします。
投稿2020/08/03 08:14
総合スコア2136
ご回答ありがとうございます！
ご丁寧な回答ありがとうございます！
大変恐縮なのですが、試す前に自己解決致しました！
教えて頂いたコードもじっくり調べてみて勉強し精進して行きたいと思います。
本当にありがとうございます！！
あなたの回答
tips
プレビュー
