備忘録：エクセル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