指定したシートのみをCSV出力したい。

指定したシートのみをCSV出力したい。
どこを変えるとシートの選択になるのでしょうか…。
宜しくお願い致します。

'-------------------------------------------------
'CSVファイル出力処理
'-------------------------------------------------
Sub createCsvFile()

'シートの件数 Dim sheetCount As Integer 'ファイル書き込み用文字列 Dim lineText As String 'ADODB.Streamオブジェクト Dim adoSt As Object '申請情報全件リスト Dim shinseiAllList As New Collection 'エラーメッセージリスト Dim errorMessageList As Collection 'CSV出力先パス Dim csvFilePath As Variant 'CSV出力エラー情報ファイルパス Dim errorFilePath As String '保存先選択ダイアログを表示する csvFilePath = Application.GetSaveAsFilename(InitialFileName:=CSV_FILE_NAME, FileFilter:="CSVファイル,*.csv") '保存先が選択されなかった場合、処理を終了する If csvFilePath = False Then Exit Sub 'シートの件数を取得する sheetCount = ThisWorkbook.Worksheets.Count 'シートの件数分繰り返す For i = 1 To sheetCount '申請様式のみ申請情報取得処理を行う If ThisWorkbook.Worksheets(i).Name <> TEMPLATE_SHEET_NAME And _ ThisWorkbook.Worksheets(i).Name <> SHEET_M_CODE And _ ThisWorkbook.Worksheets(i).Name <> SHEET_M_KYOKUSHO And _ ThisWorkbook.Worksheets(i).Name <> SHEET_M_TODOFUKEN And _ ThisWorkbook.Worksheets(i).Name <> SHEET_M_JICHITAI And _ ThisWorkbook.Worksheets(i).Name <> FILE_DEFINITION_SHEET_NAME1 And _ ThisWorkbook.Worksheets(i).Name <> FILE_DEFINITION_SHEET_NAME2 And _ ThisWorkbook.Worksheets(i).Name <> FILE_DEFINITION_SHEET_NAME3 And _ ThisWorkbook.Worksheets(i).Name <> FILE_DEFINITION_SHEET_NAME4 Then '申請情報を取得する shinseiAllList.Add getShinseiList(i) End If Next i '申請情報のエラーチェックを行う Set errorMessageList = errorCheck(shinseiAllList) 'エラーメッセージリストの件数を確認する If errorMessageList.Count >= 1 Then 'エラーメッセージリストの件数が1件以上の場合 'CSV出力エラー情報ファイルパスを取得する errorFilePath = ThisWorkbook.Path & "\" & Format(Now, "yyyymmdd_hhmmss_") & ERROR_TXT_FILE_NAME 'CSV出力エラー情報ファイルを開く Open errorFilePath For Output As #1 'エラーメッセージリストの件数分繰り返す For Each ErrorMessage In errorMessageList 'CSV出力エラー情報ファイルにエラーメッセージを書き込む Print #1, ErrorMessage Next 'CSV出力エラー情報ファイルを閉じる Close #1 '申請情報の入力エラーダイアログを表示する MsgBox SHEET_CSV_FILE_OUTPUT_ERROR_MESSAGE1 & vbCrLf & errorFilePath Exit Sub End If 'ADODB.Streamオブジェクトを生成 Set adoSt = CreateObject("ADODB.Stream") 'ADODB.Streamオブジェクトを開く With adoSt .Charset = CSV_ENCODE .LineSeparator = adCRLF .Open End With 'CSV書き込み For Each shinseiList In shinseiAllList 'ファイル書き込み用文字列の初期化 lineText = "" '改行チェック Call newLineCheck(shinseiList) '申請情報リストの件数分繰り返す For Each Item In shinseiList 'ファイル書き込み用文字列に、「,」と申請情報を追加する lineText = lineText & CSV_DELIMITER & Item Next 'ファイル書き込み用文字列の先頭の「,」を削除する lineText = Mid(lineText, 2) 'ADODB.Streamオブジェクトにファイル書き込み用文字列を書き込む adoSt.WriteText lineText, adWriteLine Next 'ADODB.Streamオブジェクトのファイル保存処理 adoSt.SaveToFile csvFilePath, adSaveCreateOverWrite 'ADODB.Streamオブジェクトを閉じる adoSt.Close 'CSVファイル出力完了ダイアログを表示する MsgBox SHEET_CSV_FILE_OUTPUT_DIALOG_MESSAGE

End Sub

コメントを投稿

0 コメント