エクセルにて、VBAで名前を付けて保存する場合

質問

こんにちは、色々試しているのですが、うまくいかずに悩んでいます。

コマンドを実行すると、名前を付けて保存のダイアログ画面を表示させるＶＢＡを作りたいです。
ただし、
(1)保存せずに、ダイアログを表示させる状態で停止させる。
(2)ダイアログ表示時、ファイル名欄に”売上集計表yyyy年mm月”というファイル名が入っている。（yyyyとmmは変数。コマンド実行時に入力する事でファイル名もそれに対応する。）

以下の様にVBAを組んだのですが（他にも色々組んでいますが、うまく動いている個所は省いてます。）、上記(1)(2)共に思い通りに動いてくれません。分かるかたがいましたら、よろしくお願いします。

Sub 保存()
'
' Macro1 Macro

Dim rtn
Dim myD As String, msg As String, fn As String, x As String
Dim wb As Workbook, ws As Worksheet
line:
' 年月の入力処理
rtn = Application.InputBox("入力する月を西暦YYYYMM形式で入力してください。" _
& vbNewLine & "例）2011年7月⇒201107", Type:=1)
If rtn = False Then Exit Sub
myD = Left(rtn, 4) & "/" & Right(rtn, 2) & "/01"
If Not IsDate(myD) Then
MsgBox "存在しない年月です！", vbCritical
GoTo line
Else
If MsgBox(Format(myD, "yyyy年mm月") & "で間違いないですか？", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If

'ファイルの保存
ChDir "C:\Users\（ユーザー名）\Desktop\新しいフォルダー"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\（ユーザー名）\Desktop\新しいフォルダー\売上集計表保存" & "Year(myD)" & "年" & "Month(myD)" & "月" & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

回答No.2

merlionXX · ベストアンサー

ファイル名入りのダイアログを出すなら
Application.Dialogs(xlDialogSaveAs).Show ARG1:="C:\Users\（ユーザー名）\Desktop\新しいフォルダー\売上集計表保存" & Format(myD, "yyyy年m月") & ".xlsm", ARG2:=1

ところで
http://okwave.jp/qa6791070.html
これはどうなってしまったのですか？
まったく同じことをきいているようですが。

補足

前回の質問も含めて色々やっていたのですが、保存の部分だけうまくいかず、悩んだ末に再度できない部分だけ質問させて頂きました。
無事解決しました。ありがとうございました。

回答No.4

imogasi

エクセル・ダイアロウグの応用です。エクセルで出てくるダイアロウグそのもので、使う側の人に違和感は無いでしょう。
Sub test01()
x = Application.Dialogs(xlDialogSaveAs).Show(arg1:="C:\Documents and Settings\xxxx\デスクトップ\売上集計表保存.xls", arg2:=43)
End Sub
上記は、保存先に、「デスクトップ」、「ファイル名」に「売上集計表保存.xls」が表示されて応答待ち（保存かキャンセルのボタンクリック待ち）になります。
arg2はファイル形式です。
ファイル指定方法は、色々在ります。上記でよければ、Google照会して、さらに疑問点があれば、調べてください。
上記では保存先に、「デスクトップ」、「ファイル名」に「売上集計表保存.xls」を当初表示してますが、すべてユーザーに任せる方法でもこれを使えます。
上記コードのXを調べることで、ダイアロウグウインドウに対し、ユーザーのキャンセル（閉じるボタンクリック）も察知できます。

回答No.3

keithin

＞やり方が悪いんでしょうか？

はい。ちゃんとやればちゃんと表示されます。

としか，お答えのしようがありません。
具体的にどんなマクロで試しているのか，「失敗しているマクロ」をキチンとそのままコピーして情報提供してください。
そうすれば，ここがミスってますよとかこうしましょうといった「次の一手」のアドバイスも，すぐに皆さんから寄せられます。

＃それで。
こちらもゴメンナサイ，回答したマクロに（追加ご質問でひっかかってるのとは別の箇所で）ミスがありました。

訂正：
dim res as variant
chdrive "C"
chdir "C:\Users\（ユーザー名）\Desktop\新しいフォルダー"
res = application.getsaveasfilename(initialfilename:="売上集計表保存" & format(myD, "yyyy年m月") & ".xlsm")
if res = false then exit sub
activeworkbook.saveas filename:=res, fileformat:=xlOpenXMLWorkbookMacroEnabled

失礼しました。

補足

>具体的にどんなマクロで試しているのか，「失敗しているマクロ」をキチンと
>そのままコピーして情報提供してください。
基本的には、『’ファイルの保存』以下をそのままコピペしただけなのですが・・・他の方の情報から解決しましたので大丈夫です。
ありがとうございました。

回答No.1

keithin

ファイルの保存から
dim res as string
chdrive "C"
chdir "C:\Users\（ユーザー名）\Desktop\新しいフォルダー"
res = application.getsaveasfilename(initialfilename:="売上集計表保存" & format(myD, "yyyy年m月") & ".xlsm")
if res = "" then exit sub
activeworkbook.saveas filename:=res

補足

やり方が悪いんでしょうか？
名前を付けて保存の画面は出ますが、ファイル名欄に指定したファイル名が表示されません・・・