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

質問

先日 https://okwave.jp/qa/q10301453.html と https://okwave.jp/qa/q10301885.html にて PDF化の際に『Microsoft Print to PDF』を自動選択できるマクロをご教示いただきましたが、さらに欲が出てきました。

前回・前々回は固定ファイルに埋め込むマクロでしたが、今回は不特定多数のファイルに使用したいため PERSONAL.XLSB に組み込みたいのです。

<やりたいこと>
１．PDF化の際に『Microsoft Print to PDF』を自動選択
２．PDFファイル名はExcelファイル名を初期値としてセット
３．保存場所をExcelファイル名と同じ場所を初期表示した上で名前を付けて保存画面を表示

自分なりに頑張って設定したのですが、Call Sh.PrintOutが設定されているためなのか自動保存された上で名前を付けて保存画面表示が出るという状態です。

Sub PDF_別名保存()

Dim saveFolder As String: saveFolder = ActiveWorkbook.Path & "\" 'Excelファイルと同じフォルダ

Dim FSO As Object
Dim fname As String
Dim fullname As String
Dim Done As Variant
Dim Sh As Object
Set Sh = ActiveWindow.SelectedSheets
Dim orgPrinter As String

'ファイルを操作するオブジェクト
Set FSO = CreateObject("Scripting.FileSystemObject")

'Excelファイル名(拡張子なし)をPDFファイル名にする
fname = FSO.GetBaseName(ActiveWorkbook.name) & ".pdf"
fullname = saveFolder & fname

'『Microsoft Print to PDF』を自動設定
orgPrinter = Application.ActivePrinter
Call Sh.PrintOut(ActivePrinter:="Microsoft Print to PDF", PrintToFile:=True, PrToFileName:=fullname)
Application.ActivePrinter = orgPrinter
Set Sh = Nothing

'名前を付けて保存画面表示
Done = IIf(Application.Dialogs(xlDialogSaveAs). _
Show(Arg1:=fullname, Arg2:=57), "保存", "キャンセル")

If Done = "キャンセル" Then

Else

End If

End Sub

どの部分を改修すればよろしいのでしょうか？

尚、選択したsheetをPDFファイル名にして自動保存するマクロと、Excelファイル名をPDFファイル名にして自動保存するマクロはできました。

回答No.1

kkkkkm · ベストアンサー

Application.Dialogs(xlDialogSaveAs)
ではなく
Application.GetSaveAsFilename
を利用すれば保存動作は別途記載する形でフルパスのファイル名だけ取得できます。

Sub PDF_別名保存()

Dim saveFolder As String: saveFolder = ActiveWorkbook.Path & "\" 'Excelファイルと同じフォルダ

Dim FSO As Object
Dim fname As String
Dim fullname As Variant '←これは変更しています
Dim Done As Variant
Dim Sh As Object
Set Sh = ActiveWindow.SelectedSheets
Dim orgPrinter As String

'ファイルを操作するオブジェクト
Set FSO = CreateObject("Scripting.FileSystemObject")

'Excelファイル名(拡張子なし)をPDFファイル名にする
fname = FSO.GetBaseName(ActiveWorkbook.Name) & ".pdf"
fullname = saveFolder & fname

'名前を付けて保存画面表示
fullname = Application.GetSaveAsFilename(InitialFileName:=fullname, FileFilter:="PDFファイル,*.pdf")
If fullname = False Then
MsgBox "キャンセルされました", vbInformation
Exit Sub
End If

'『Microsoft Print to PDF』を自動設定
orgPrinter = Application.ActivePrinter
Call Sh.PrintOut(ActivePrinter:="Microsoft Print to PDF", PrintToFile:=True, PrToFileName:=fullname)
Application.ActivePrinter = orgPrinter
Set Sh = Nothing

End Sub

お礼

前回・前々回に引き続きご回答ありがとうございました。

パーフェクトです!!
内容は全然理解できませんが、そのままコピペして理想通りの動きをしてくれました。
キャンセル時のメッセージボックスも追加していただき、ありがとうございました。

PDF化に関しては、これでやりたいことは一通り終わったつもりです。
ですが、他の担当者からいろいろな要望が出てくる可能性もありますので、その際はよろしくお願いします。