エクセル 指定範囲をCSV出力

エクセル2016で
下記マクロで指定範囲をCSVで出力するようにしているのですが
名前を付けて保存の画面が表示されたときに
ファイル名の欄に作業中のファイル名が表示されません。
エクセル2010では表示されてたのですが2016ではできなくなりました。
修正案を教えていただけないでしょうか。
よろしくお願いいたします。

Sub CSV()
Dim myRng As Range, myFileName As String
Set myRng = Range("A:A,B:B,C:C")
If myRng Is Nothing Then Exit Sub
myFileName = Application.GetSaveAsFilename(FileFilter:="CSVファイル (*.csv,*.csv")
If myFileName = "False" Then Exit Sub
Application.ScreenUpdating = False
With Worksheets.Add
myRng.Copy .Cells(1, 1)
.Move
End With
With ActiveWorkbook
.SaveAs Filename:=myFileName, FileFormat:=xlCSV
.Close False
End With
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub

No.4 ベストアンサー 回答者： WindFaller 回答日時： 2019/04/11 13:19

>作業中のファイル名が表示されませんでした。

>エクセル2010では問題ないので、やはりバグなのでしょうか？
>また何かお気付きされましたら教えてください。

ここの掲示板で、Excel 2013以降で再現可能なバグらしきものに出会うことが増えているように思います。SDI(Single Document Interface) せいなのでしょうか。Excel 2010 は、なかなか手放すことができません。

・Application.Dialogs(xlDialogSaveAs).Show , 6
これで表示は出るにしても、古いダイアログでファイル名を単独では取得できないので、あまりお勧めできません。

No.3のコードで、以下の部分にブレークポイントをつけて、bkNameの変数がどうなっているか調べることはできますか?
もし、ご存知でしたら、以下は無視してください。

ブレークポイントは、VBA Editor の上部のデバックメニューか、または、左端の該当する行の枠の部分をワンクリックすると、●が付きます。それで実行すると、その部分で止まります。（添付画像)

myFileName = Application.GetSaveAsFilename(bkName, "CSVファイル (*.csv),*.csv")

そこで、ローカルウィンドウ（表示メニューの中)で、変数のbkNameが取れているかどうかを調べます。それで確認したら、「F8} を押し、実際のダイアログを出します。

変数で取得して も、ダイアログでファイル名が出ないとしたら、別案のFileDialogを提示します。前回のものを入れ替えてみました。(以下は、一部、拡張子を取る部分が無駄があります。また、Excel2016以外では試していませんので、.FilterIndex =16 の部分が、下位バージョンで変わるはずです)

'//
Sub SampleCSV2()
　Dim myRng As Range
　Dim myFileName As String
　Dim bkName As String, i As Long
　bkName = ActiveWorkbook.Name
　i = InStrRev(bkName, ".")
　If i > 0 Then
　　bkName = Left(bkName, i - 1) '拡張子を取る
　End If
　Set myRng = Range("A:C")
　If Application.CountA(myRng) = 0 Then Exit Sub
　'Application.ScreenUpdating = False 'ないほうが良いかもしれない。
　With Worksheets.Add
　　myRng.Copy
　　.Cells(1, 1).PasteSpecial (xlPasteValues) 'ボタンオブジェクトをコピーしないようにする。
　　.Move 'シートの移動
　End With
　Application.CutCopyMode = False 'コピーモードを終了
　'===========入れ替えしました=======
　With Application.FileDialog(msoFileDialogSaveAs)
　　.InitialFileName = bkName
　　.FilterIndex = 16 '"*.csv"
　　If .Show = -1 Then
　　　myFileName = .SelectedItems(1)
　　Else
　　　ActiveWorkbook.Close False '途中でやめた時、ブックを捨てる
　　　Exit Sub
　　End If
　End With
　'===========
　With ActiveWorkbook
　　On Error Resume Next 'ファイル名上書きをキャンセル等した時のため
　　.SaveAs Filename:=myFileName, FileFormat:=xlCSV
　　On Error GoTo 0
　　.Close False
　End With
　'Application.ScreenUpdating = True
　Set myRng = Nothing
End Sub
'//

画像はデバッグの検査

この回答へのお礼

回答ありがとうございます。
No.3のコードで変数のbkNameは取れてました。
そのまま何回か実行してみましたが、問題なく表示されるようになりました。
色々とありがとうございました。

お礼日時：2019/04/11 17:08

No.3 回答者： WindFaller 回答日時： 2019/04/11 00:44

こんばんは。

5～6時間開いたままのExcelのファイルで再びやってみたら、どうやってもて出てこなくなってしまいました。これはバグの一種ではないでしょうか。

Application.Dialogs(xlDialogSaveAs).Show , 6
さらに、代用でこの方法でやっていたら、GetSaveAsFilename が、再び出てきましたね。一体どうなっているのか分かりませんが、一つの想像としては、GetSaveAsFilename から後の手順が多いせいなのかもしれないと思いました。

ご質問者のwa-i-waiさんには、以下は問題解決には直結しないので、不本意かもしれませんが、私の想像の範囲から、書き直してみました。もちろん、元のご質問に出たコードは、何も問題がないと思います。

'//
Sub SampleCSV()
　Dim myRng As Range
　Dim myFileName As String
　Dim myFleName As String
　Dim bkName As String, i As long
　bkName = ActiveWorkbook.Name
　i = InStrRev(bkName, ".")
　If i > 0 Then
　　bkName = Left(bkName, i - 1) '拡張子を取る
　End If
　Set myRng = Range("A:C")
　If Application.CountA(myRng) = 0 Then Exit Sub
　'Application.ScreenUpdating = False 'ないほうが良いかもしれない。
　With Worksheets.Add
　　 myRng.Copy
　　.Cells(1, 1).PasteSpecial (xlPasteValues) 'ボタンオブジェクトをコピーしないようにする。
　　.Move　'シートの移動
　End With
　Application.CutCopyMode = False 'コピーモードを終了
　myFileName = Application.GetSaveAsFilename(bkName, "CSVファイル (*.csv),*.csv")
　If myFileName = "False" Then
　　ActiveWorkbook.Close False　'途中でやめた時、ブックを捨てる
　　Exit Sub
　End If
　With ActiveWorkbook
　　On Error Resume Next　'ファイル名上書きをキャンセル等した時のため
　　.SaveAs Filename:=myFileName, FileFormat:=xlCSV
　　On Error GoTo 0
　　.Close False
　End With
　'Application.ScreenUpdating = True
　Set myRng =Nothing
End Sub

この回答へのお礼

回答ありがとうございます。
朝一番で頂いたコードで実行してみたのですが
名前を付けて保存の画面でファイル名の欄に
作業中のファイル名が表示されませんでした。
エクセル2010では問題ないので、やはりバグなのでしょうか？
また何かお気付きされましたら教えてください。
よろしくお願いいたします。

お礼日時：2019/04/11 09:20

No.2 回答者： WindFaller 回答日時： 2019/04/10 16:42

こちらも、Excel 2016で試しています。

前回直した3行を、以下に換えて試してみてください。

Set myRng = Range("A:C")
If Application.CountA(myRng) = 0 Then Exit Sub
myFileName = Application.GetSaveAsFilename(, FileFilter:="CSVファイル (*.csv),*.csv")

この回答へのお礼

回答ありがとうございます。
前回直した3行を変更してみましたが、
名前を付けて保存の画面でファイル名の欄に
作業中のファイル名が表示されませんでした。
現状下記なのですが、違ってましたら教えてください。
よろしくお願いいたします。

Sub 全角CSV()
Dim Acbk As String
Acbk = ActiveWorkbook.Name
Acbk = Left(Acbk, InStrRev(Acbk, ".") - 1)
Set myRng = Range("A:C")
If Application.CountA(myRng) = 0 Then Exit Sub
myFileName = Application.GetSaveAsFilename(, FileFilter:="CSVファイル (*.csv),*.csv")
If myFileName = "False" Then Exit Sub
Application.ScreenUpdating = False
With Worksheets.Add
myRng.Copy .Cells(1, 1)
.Move
End With
With ActiveWorkbook
.SaveAs Filename:=myFileName, FileFormat:=xlCSV
.Close False
End With
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub

お礼日時：2019/04/10 17:13

No.1 回答者： WindFaller 回答日時： 2019/04/10 13:53

ご質問は、この部分のことでしょうか?

myFileName = Application.GetSaveAsFilename(FileFilter:="CSVファイル (*.csv,*.csv")

それは、拡張子を取り除いて上げれば、InitialNameが出てきます。

　Dim Acbk As String
　Acbk = ActiveWorkbook.Name
　Acbk = Left(Acbk, InStrRev(Acbk, ".") - 1)
　Set myRng = Range("A:C")
　If Application.CountA(myRng) = 0 Then Exit Sub
　myFileName = Application.GetSaveAsFilename(Acbk, "CSVファイル (*.csv),*.csv")

この回答へのお礼

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

下記部分
Dim myRng As Range, myFileName As String
Set myRng = Range("A:A,B:B,C:C")
If myRng Is Nothing Then Exit Sub
myFileName = Application.GetSaveAsFilename(FileFilter:="CSVファイル (*.csv,*.csv")
を
Dim Acbk As String
Acbk = ActiveWorkbook.Name
Acbk = Left(Acbk, InStrRev(Acbk, ".") - 1)
Set myRng = Range("A:C")
If Application.CountA(myRng) = 0 Then Exit Sub
myFileName = Application.GetSaveAsFilename(Acbk, "CSVファイル (*.csv),*.csv")
に変更してみましたが、ダメでした。

他、何か思い当たる部分はありますでしょうか？

よろしくお願いいたします。

お礼日時：2019/04/10 14:30