備忘録:エクセルVBA ・指定したシートをCSVファイルに出力する
ソースを丸ごと張り付けるだけ。VBAを実行すると、全てのシート名が入力された状態でInputBoxが表示されるので、出力したいシート名だけをInputBoxに残し、その後ファイルの保存先を選択すれば、CSVファイルが作成される。
同名のファイルがある場合は上書保存され、同名のファイルが開かれている場合は、エラーとなり処理が終了されます。
Sub csv_output() '指定したシートをCSVファイルに出力する Dim CsvName As Variant '出力ファイルのフルパス Dim OutSeet As Worksheet '出力対象のシート Dim i As Integer Dim mySheetCnt As Long '既存シート数 Dim mySheetName As String 'シート名一覧 Dim TgtSeetName As String 'InputBoxの戻り値 '出力するシート名の選択 mySheetCnt = ThisWorkbook.Sheets.Count For i = 1 To mySheetCnt mySheetName = mySheetName & Sheets(i).Name & "," Next i TgtSeetName = Application.InputBox(Prompt:="出力を行うシート名を正確に入力してください。" _ & vbLf & "(表示されている中から、不要なシート名や「, 」を削除してください)", _ Title:="どのシートをエクスポートしますか?", Default:=mySheetName) If TgtSeetName = "False" Then Exit Sub Else On Error GoTo SEET_NAME_ERROR Set OutSeet = Worksheets(TgtSeetName) 'シート名セット On Error GoTo 0 End If 'ファイル保存先の取得 CsvName = Application.GetSaveAsFilename(FileFilter:="CSVファイル,*.csv") If CsvName = False Then Exit Sub End If '同名のファイルが開かれていないか確認 On Error Resume Next Open CsvName For Output As #1 Close #1 If Err.Number > 0 Then MsgBox "同名のファイルがすでに開かれています。" & vbCrLf & CsvName & _ "を閉じてやり直してください。" Workbooks(CsvName).Activate Else '対象シートをコピーしてCSVファイル保存 Application.DisplayAlerts = False OutSeet.Copy ActiveWorkbook.SaveAs FileName:=CsvName, FileFormat:=xlCSV ActiveWindow.Close Application.DisplayAlerts = True MsgBox CsvName & "を出力しました。", , "ファイル作成完了" End If SEET_NAME_ERROR: If Err.Number = 9 Then MsgBox "CSVを出力したいシート名を、正しく指定してください。", , _ "シート名が存在しません" End If Exit Sub End Sub