エクセルＶＢＡでファイルをＣＳＶ保存の仕方

質問

エクセルのシートをＣＳＶファイルに保存するため以下のようなマクロを書きました。

Sub Macro1()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs FileName:="C:\WINDOWS\デスクトップ\Book1.csv", FileFormat _
:=xlCSV, CreateBackup:=False
ActiveWindow.Close
ThisWorkbook.Activate
End Sub

一応これで保存できるのですが、自動記録でやったためファイルの名前が出てしまいました。
この部分をわたし以外の誰でも任意の名前をつけ、任意のフォルダーに保存できるように書き換えたいのです。
どのように記述すれば良いかお教えください。お願いします。

回答No.4

happypoint · ベストアンサー

>Application.Dialogs(xlDialogSaveAs).Show ARG2:=6

これはExcelの組み込みダイアログを表示するためのものです。
GetSaveAsFilenameと表示されるものは同じものですが、使い方が若干違います。

Dialogsの場合は、文字通り「名前をつけて保存ダイアログを開く」のが目的です。
つまりメニューの「ファイル-名前をつけて保存...」を選択する操作を、マクロで再現するときに使います。

この場合、ユーザーが何というファイル名を入力したか、把握することはできません。

それにたいしてGetSaveAsFilenameは、「ファイル名を取得する」のが目的です。

ダイアログ自体は同じものを表示しますが、ここで表示される「印刷」「キャンセル」のボタンは、ダミーです。
（つまり、
　ファイル名を入力して「保存」ボタンを押しても、
　実際に保存するプログラムが書かれていない限り、保存されません。）

処理を自分で各必要がありますが、より柔軟な処理をすることができます。
（独自の警告メッセージを組み込むなど。）

保存の処理の仕方をより細かくプログラムするときに使うものだと思います。

お礼

何度も何度もありがとうございました。
とてもよくわかりました。
ご親切に感謝いたします。

回答No.3

happypoint

#2です。

＞同じファイル名が会った場合、上書きいいえ、またはキャンセルを選ぶとエラーになってしまいます。

そうですね。前回の回答にもそれは書きました。

＞これはアラートを出なくするのもまずいのでなんとかしたいのです

うーむ。そうくると思いました。^^;
「ご自分で研究してみてください」、と書いたつもりなんですが。。。

上書き保存の直前にチェックをかけるからマズいのです。
こういう場合は、ファイル名を取得できたらすぐに、同名のファイルがないかチェックをかけます。

「上書きしてもいい」というユーザーの意志がはっきりしてから、
「ブックの追加」や「コピペ」などの処理を開始した方が、
「上書き保存しない」をユーザーが選択したときに、
処理が始まる前に中止できますので、無駄が少ないです。

そうすれば、保存処理のときの確認は不要になりますので、
　DisplayAlerts = False
を効かせて、有無を言わさず「保存」でOKです。

Sub Macro1()
Dim varFileName As Variant
Dim myYN As Boolean

'ファイル名をつけさせる
varFileName = Application.GetSaveAsFilename(InitialFileName:="新しいCSVファイル", FileFilter:="CSVファイル (*.csv),*.csv")
If varFileName = False Then Exit Sub

'同名ファイルのチェック
If Dir(varFileName) <> "" Then '同名ファイルが存在しない場合は、Dir関数で""が返る
'上書きの警告を表示する
myYN = MsgBox("同名のファイルがすでに存在します。" & Chr(13) & _
"上書きしてもよろしいですか？", vbYesNo + vbExclamation)
If myYN = vbNo Then Exit Sub
End If

'処理
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False

'Excelが表示する上書き警告画面を抑止する
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=varFileName, FileFormat:=xlCSV, CreateBackup:=False
ActiveWindow.Close
ThisWorkbook.Activate
Application.DisplayAlerts = True
End Sub

お礼

何度もありがとうございます！
完璧です！
実はわたしもまっている間、ネットをいろいろ検索してこんなのをみつけてやってみました。

Sub Macro1()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False

Application.Dialogs(xlDialogSaveAs).Show ARG2:=6 '（.xlsは1だが.csvは6のようでした )

Application.DisplayAlerts = False
ActiveWindow.Close
ThisWorkbook.Activate
Application.DisplayAlerts = True
End Sub

これでも同じですよね？

回答No.2

happypoint

質問にあるコードをできるだけ生かす方向で、
「名前をつけて保存」する機能を追加してみました。

同じ名前のファイルなどがあったときの「エラー処理」などをまったく組み込んでいないので、
このまま使うというわけにはいかないでしょうが、
そのへんは、ご自分で研究されてみてください。

Sub Macro1()
Dim varFileName As Variant

'保存するファイル名をつけさせる
varFileName = Application.GetSaveAsFilename(InitialFileName:="新しいCSVファイル", FileFilter:="CSVファイル (*.csv),*.csv")
If varFileName = False Then Exit Sub

'ほとんど質問のコードを使いました。
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False

'ここで、さきほど取得したファイル名（varFileName）を使いました。
ActiveWorkbook.SaveAs _
Filename:=varFileName, FileFormat:=xlCSV, CreateBackup:=False

'ふたたび、質問のコードを使いました。
ActiveWindow.Close
ThisWorkbook.Activate

End Sub

補足

ありがとうございますたすかりました。
最後に再度、保存するかどうか聞いてくるところは以下の通りとめられましたが、同じファイル名が会った場合、上書きいいえ、またはキャンセルを選ぶとエラーになってしまいます。これはアラートを出なくするのもまずいのでなんとかしたいのです。
なんとかよろしくお願いいたします。すみません。

Sub Macro1()
Dim varFileName As Variant
varFileName = Application.GetSaveAsFilename(InitialFileName:="新しいCSVファイル", FileFilter:="CSVファイル (*.csv),*.csv")
If varFileName = False Then Exit Sub
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs _
FileName:=varFileName, FileFormat:=xlCSV, CreateBackup:=False

'ふたたび、保存を聞いてくるのをとめた。

Application.DisplayAlerts = False
ActiveWindow.Close
ThisWorkbook.Activate
Application.DisplayAlerts = True
End Sub

回答No.1

maruru01

こんにちは。maruru01です。

InputBox関数で入力を促すか、どこかのセルに入力してそれを変数に代入すればいいと思います。

Sub Macro1()

　　Dim tempFolder As String
　　Dim tempFileName As String

　　'フォルダ名とファイル名を取得して変数に格納
　　tempFolder = フォルダ名
　　tempFileName = ファイル名

　　（途中省略）
　　ActiveWorkbook.SaveAs FileName:=tempFolder & tempFileName, FileFormat _
:=xlCSV, CreateBackup:=False

　　（途中省略）

End Sub

こんな感じです。

お礼

さっそくありがとうございます。