【Excel365マクロ】プリンター指定

質問

下記マクロでシートをPDF化しています。

<マクロ１>

Sub PDF保存_指定フォルダ()

Application.Dialogs(xlDialogPrinterSetup).Show

Const saveFolder = "C:\PDF\"
Dim fname As String
Dim fullname As String
fname = ActiveSheet.Range("A1").Value & ".pdf" 'A1セルの文字をファイル名にする
fullname = saveFolder & fname
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fullname

End Sub

<マクロ２>

Sub PDF保存_同一フォルダ()

Application.Dialogs(xlDialogPrinterSetup).Show

Dim FileName As String
FileName = ActiveSheet.Range("L4").Value & "_Invoice" & ".pdf" 'A1セルの文字をファイル名にする

'Excelファイルと同じフォルダへ保存
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=ActiveWorkbook.Path & "\" & FileName

End Sub

用紙サイズをA4縦に固定したいので、「Application.Dialogs(xlDialogPrinterSetup).Show」でプリンター設定画面を表示させて『Microsoft Print to PDF』を選択するようにしています。
プリンター設定画面を表示させなくてもマクロ内で『Microsoft Print to PDF』を設定する方法はありませんか？

プリンター名確認マクロで「Microsoft Print to PDF on Ne01:」と表示されますが”Ne01”はPCによって異なる可能性がありますので、できれば「Microsoft Print to PDF」のみを指定できればありがたいです。
会社PC(Win10／Win11)ですので「Microsoft Print to PDF」がある前提で構いません。

よろしくお願いします

回答No.3

kkkkkm · ベストアンサー

> Sub Testと同じマクロで「Excelファイルと同じフォルダへ保存」できるとありがたいです。

Sub Testのコードを2か所変更してください。

Const saveFolder = "C:\PDF\"

のところを

Dim saveFolder As String: saveFolder = ActiveWorkbook.Path & "\"

に変更して

fname = ActiveSheet.Range("A1").Value & ".pdf"

を

fname = ActiveSheet.Range("A1").Value & "_Invoice" & ".pdf"

に変更して試してみてください。

同じブックで実行するのでしたら以下のようにPDF書き出し部分(Test)を一個にして呼び出すようにしてもいいと思います。

Sub PDF保存_指定フォルダ()
Call Test("C:\PDF\", ActiveSheet.Range("A1").Value & ".pdf")
End Sub

Sub PDF保存_同一フォルダ()
Call Test(ActiveWorkbook.Path & "\", ActiveSheet.Range("A1").Value & "_Invoice" & ".pdf")
End Sub

上のどちらかを実行します。

Sub Test(ByVal saveFolder As String, ByVal fname As String)
Dim fullname As String
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim orgPrinter As String

fullname = saveFolder & fname
orgPrinter = Application.ActivePrinter
Call Sh.PrintOut(ActivePrinter:="Microsoft Print to PDF", PrintToFile:=True, PrToFileName:=fullname)
Application.ActivePrinter = orgPrinter
Set Sh = Nothing '←前回入れ忘れていたので念のために入れておいてください
End Sub

お礼

何度もご回答ありがとうございました。

できました!!
すばらしいの一言です。

これだったら、フォルダ指定・ファイル名指定など複数のマクロを作成する際、1マクロにつきたった3行の追加ですみます。
実のところ、担当者によって細かい指定があるので、マクロが増えすぎて困っていたところです。

大変助かりました。

回答No.2

kkkkkm

> 提示していただいたマクロをどのように組み込めばいいのかさっぱり分かりません。

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fullname

の部分をURLで示した質問のコードに置き換えればいいと思います。
参考までに

Sub Test()
Const saveFolder = "C:\PDF\"
Dim fname As String
Dim fullname As String
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim orgPrinter As String

fname = ActiveSheet.Range("A1").Value & ".pdf" 'A1セルの文字をファイル名にする
fullname = saveFolder & fname
orgPrinter = Application.ActivePrinter
Call Sh.PrintOut(ActivePrinter:="Microsoft Print to PDF", PrintToFile:=True, PrToFileName:=fullname)
Application.ActivePrinter = orgPrinter

End Sub

お礼

再度のご回答ありがとうございました。

できました!!
完璧です。

マクロ１もマクロ２もググって出てきたマクロをそのままコピペしただけですので、内容はまったく理解できていません。
マクロ2(L4ではなくA1の間違いでした)の方もマクロをご教示いただくことは可能でしょうか？
Sub Testと同じマクロで「Excelファイルと同じフォルダへ保存」できるとありがたいです。
難しいようでしたらマクロ2のまま組み込んでいただければ結構です。

よろしくお願いします。

回答No.1

kkkkkm

Microsoft Print to PDF
https://okwave.jp/qa/q10297682.html
こちらのやり取りが参考になると思います。

お礼

ご回答ありがとうございました。

提示していただいたマクロをどのように組み込めばいいのかさっぱり分かりません。
勉強不足で申し訳ありません。