Excel VBA シートを指定してpdf化

指定のフォルダに入っている全てのエクセルファイルをシートを指定して一つのpdfファイルに変換したいと考えています。全てのエクセルファイルにはSheet1～Sheet5まであり、Sheet1～Sheet4までをpdf化させたいのですが、なかなか上手くいきません。

どなたかご教授願えれば幸いです。試作したマクロコードは下記になります。よろしくお願いいたします。

Sub pdf()
'変換対象の.exlsファイルを保存したフォルダ
Const PATH = "E:\Exceclデータ\vba\"

'.xlsなどのファイルを検索
Dim file As String
file = Dir(PATH & "*.xlsx")

'すべての検索結果を取得するまでのループを継続
Do While file <> ""
Dim tmp_path As String
tmp_path = PATH & file

'ファイルを開いて、PDF形式でエクスポート
Workbooks.Open tmp_path

Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
Sheets("Sheet1").Activate


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tmp_path & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


'現在のファイルを閉じる
ActiveWorkbook.Close

'次に合致するファイルを取得
file = Dir()

Loop

End Sub

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2016/08/22 01:32

こんばんは。

#1の回答者です。

>「実行時エラー　1004
>ドキュメントを保存できませんでした。ドキュメントを開いているか、保存時にエラーが発生した可能性があります。」

なるほど、コードの問題ではありませんね。

office2010のPDF保存機能で 「ドキュメントが開いているかエラーが発生しています」 のエラーが発生する
http://answers.microsoft.com/ja-jp/office/forum/ …

「通常モードでPDFを保存オプションを開き「ISO19005-1に準拠（PDF/A）」のチェックを外したところ、正常に保存することができるようになりました」
とあります。一度、手動で直してみてから、試したらどうなるでしょうか。

この回答へのお礼

御礼が遅れて申し訳ございません。無事上手くいきました！
いろいろとアドバイスくださりありがとうございました<m(__)m>

お礼日時：2016/08/25 23:28

No.1 回答者： WindFaller 回答日時： 2016/08/21 19:27

コードを読みましたが、特に大きな問題はないようですが。

本当は、どこがうまく行かないのか書かれていたら、ピンポイントで解答ができたと思います。

>'すべての検索結果を取得するまでのループを継続
>Do While file <> ""
>Dim tmp_path As String　　'←VBAでは、ここには置かないです。
>tmp_path = PATH & file

別に問題があるわけではないのです。ただ、気になるだけです。

>Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
ここは確かですか？ シート名がそのようになっていればよいのですが、
以下のようにインデックスで指定する方法もあります。インデックスは、左から1,2,3と数えていきます。

以下の場合は、シート名が違っている場合、シートの数が4つがない場合と4つより多い場合に対処できます。

もうひとつ心配のたねは、1ページがうまく収まっていればよいのですが、右にはみ出たりしてしまっていると、PDFの中身が汚くなってしまいます。

それと、PATHは、生の名称でなくて、mPATHにしました。
プロパティ名で使われていると、ややこしいことになることもありますから。m は、myの m　+PATH
'//

tmp_path = mPATH & File
With Workbooks.Open(tmp_path)
　 For i = 1 To .Worksheets.Count
　　 .Worksheets(1).Select (False)
　　 If i >= 4 Then Exit For '4つまでで離脱
　 Next i
　Worksheets(1).Activate
'-- pdf--　処理
　.Close False　'再計算などで変化があっても、保存を聞いてこないようにする
End With
tmp_path = ""　　'ここでクリア
'次に合致するファイルを取得
File = Dir()
Loop
'//


最後に、画面の切り替わりがうっとうしいですね。

Application.ScreenUpdating = False


Application.ScreenUpdating = True
で、Loop の所を挟んだほうがよいです。

このアドバイスでダメでしたら、こちらのサンプルコードをアップロードします。

この回答へのお礼

ご回答ありがとうございます。いただいたVBAを試してみましたがやはり上手く作動しないようです…

また自分のVBAに出ていた症状としては、数個のpdf化は上手くいくのですが途中で下記のメッセージが出て変換が終わってしまうというものです。ちなみにドキュメントは開いていませんでした。

「実行時エラー　1004
ドキュメントを保存できませんでした。ドキュメントを開いているか、保存時にエラーが発生した可能性があります。」

デバックすると↓に問題があるようです…
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tmp_path & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

お礼日時：2016/08/21 20:26