VBAでデスクトップの指定のフォルダに保存

質問

毎度お世話になっております。

さて、先日ここで表題につき教えていただいた、下記のコードはフォルダのパスをセルで指定する場合のコードなのですが、セル内容で指定するのではなくデスクトップの決まった名前のフォルダを指定したいのですが、当方には修正できません。

ファルダをC:￥XXXのフルパスで指定するのではなく、いろんなPCのデスクトップにある「見積書」というフォルダに保存したいのです。

＞そんなときは、WSH(Windows Scripting Host)を使います。
と例題まであるのですが、当方には応用が出来ず。
このレベルなのでどなたかHELPお願い致します。

エクセルのファイル形式は「xlOpenXMLWorkbook」の部分でマクロ有効、無効が選択できるようにしたいのでこの部分は当方でいじれるようにご配慮お願いします。

=================＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub シートのセルで指定()

Application.DisplayAlerts = False
ThisWorkbook.SaveAs [Sheet1!A1] & "\" & [A2] & [C1], xlOpenXMLWorkbook
Application.DisplayAlerts = True

Application.Dialogs(xlDialogPrint).Show

End Sub

回答No.5

kkkkkm · ベストアンサー

> 質問では、拡張子を選択できるように、と書きましたのでこれは満たしているのですが、追加で申し訳ないのですが元のコードも含めて保存したいのですが、何とかできませんでしょうか?

もともとxlOpenXMLWorkbookを付けてますし、これはマクロ無でファイルを保存するという意思表示になります。

質問に
> エクセルのファイル形式は「xlOpenXMLWorkbook」の部分でマクロ有効、無効が選択できるようにしたいのでこの部分は当方でいじれるようにご配慮お願いします

とあったので、そこは何か対策をするのだろうと思ったのですが…。

マクロ有効でもともとマクロのあるファイルでしたら
, xlOpenXMLWorkbook
を消せばいいだけです。

マクロ絶対でしたら, xlOpenXMLWorkbookのかわりに
, xlOpenXMLWorkbookMacroEnabled

お礼

うまく行きました!!
またまた、余計なことを書いたがために混乱させてしまい何度もお手数をおかけしてしまいました。

何も指定しないと元のファイル形式で保存されるのですね?
これを知らなかったので、NETでは指定したりしなかったりのコードがあったので、指定すれば確実にマクロごと保存されると思い、この部分を記載したコードでお願いしました。

このレベルに最後までお付き合い頂きありがとうございました。

回答No.4

kkkkkm

> 確かに最後の￥は見落としやすく、過去にこれで動かなかったこともありました。
>
> 当方のレベルに合わせて忖度いただき感謝の２乗です。

私もたまにそういうことがあるので分けていた方が無難だなと思って分けることにしました。

お礼

お礼が足りない気がするので.。。。。
即日解決できました。
本当にありがとうございました。

回答No.3

kkkkkm

参考に示したサイトのSample3()コードを適用して一部変更(ファイル保存部分だけ)ですので以下のようにして試してみてください。

("見積書\"は"見積書" & "\"に戻しました。フォルダを変更したときに最後の\を忘れたりするので)

Sub デスクトップに保存()
Dim Path As String, WSH As Variant

Application.DisplayAlerts = False
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("Desktop") & "\"
ThisWorkbook.SaveAs Path & "見積書" & "\" & [A2] & [C1], xlOpenXMLWorkbook
Set WSH = Nothing
Application.DisplayAlerts = True

Application.Dialogs(xlDialogPrint).Show
End Sub

お礼

何度もの早々のご回答に感謝です!
無事期待通りに動きました。

いつもありがとうございます。

補足

確かに最後の￥は見落としやすく、過去にこれで動かなかったこともありました。

当方のレベルに合わせて忖度いただき感謝の２乗です。

回答No.2

kkkkkm

> ＞[Sheet1!A1]
> ではなく、各人のPCのデスクトップの「見積書」 というフォルダなのですが。

見落としてました。

ThisWorkbook.SaveAs Path & "見積書\" & [A2] & [C1], xlOpenXMLWorkbook

で試してみてください。

お礼

誠にすみませんが、１つ要件が抜けていました。

最後の確認で実際のシートで試してみたら、期待通りのファイル名で、xlmsで保存されているのですが、VBAのコードが反映されていませんでした。

質問では、拡張子を選択できるように、と書きましたのでこれは満たしているのですが、追加で申し訳ないのですが元のコードも含めて保存したいのですが、何とかできませんでしょうか?
当該ブックには他のコードもありこれを保持した形で保存しないと最初の目的が達成できないので。

補足

何度もすみません。
早々に試したのですが、1回目は「ファイルパスが存在しません・・・・」というようなMsg、2回目は見慣れた「1004 アプリケーションまたはオブジェクトの定義エラーです」となります。

下記で何か抜けていませんでしょうか?

Sub デスクトップに保存()
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Path & "見積書\" & [A2] & [C1], xlOpenXMLWorkbook
Application.DisplayAlerts = True

Application.Dialogs(xlDialogPrint).Show

End Sub

回答No.1

kkkkkm

特殊フォルダを取得する
http://officetanaka.net/excel/vba/tips/tips107.htm

こちらに説明があります。

上記のSample3()コードを適用して

ActiveWorkbook.SaveAs Path & "Sample1.xls"
の部分を
ThisWorkbook.SaveAs Path & [Sheet1!A1] & "\" & [A2] & [C1], xlOpenXMLWorkbook
に変更して下さい。

補足

いつもお世話になっております。
早々のご回答ありがとうございます。
少し主旨が違っているようなのですが???

保存したいフォルダは
＞[Sheet1!A1]
ではなく、各人のPCのデスクトップの「見積書」 というフォルダなのですが。

デスクトップは特殊なフォルダで、「PCによらずパスを指定できる」ということで、pdfの場合は下記で使っているのですが、今回はエクセルで、拡張子を指定したく、質問に記載のコードで種々試行錯誤してみたのですが駄目でした。トホホ・・・・・・
＞xlTypePDF
を「xlOpenXMLWorkbook」等に変えたいのですが,これが出来ないのが自分でも情けない。
お手数をおかけします。

========＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 保存()
ChDrive "C:"
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\見積書"
ActiveSheet.ExportAsFixedFormat xlTypePDF, [J6] & [k6] & " " & [F24]

Application.Dialogs(xlDialogPrint).Show