|
Sub csv_output()
'
'出力したいデータ範囲を選択（例えばA1からD1までをマウスで選択）してから実行してください
'ただし、複数範囲を指定しても、一番最初に選択した範囲しか出力されません
'
Dim buff As String
Dim startCol As Integer
Dim endCol As Integer
Dim startRow As Long
Dim endRow As Long
Dim i As Long
Dim j As Long
Dim OutPutFileName As Variant
OutPutFileName = Application.GetSaveAsFilename _
(FileFilter:="テキストファイル(*.csv),*.csv", _
Title:="出力するCSVファイルの指定", _
InitialFilename:="")
If OutPutFileName = False Then 'キャンセルを押した場合 20010111
Exit Sub
End If
On Error GoTo Macro_Err
Open OutPutFileName For Output As #1
On Error GoTo 0
startCol = Selection.Column
endCol = startCol + Selection.Columns.Count - 1
startRow = Selection.Row
endRow = startRow + Selection.Rows.Count - 1
For i = startRow To endRow
If Cells(i, startCol).WrapText = True Then
buff = """" & Cells(i, startCol).Value & """" 'セル内で折り返している場合はダブルクォーテーションで囲む
Else
buff = Cells(i, startCol).Value
End If
For j = startCol + 1 To endCol '2つ目からはカンマを入れる"
If Cells(i, j).WrapText = True Then
buff = buff & ",""" & Cells(i, j).Value & """"
Else
buff = buff & "," & Cells(i, j).Value
End If
Next
Print #1, buff 'ファイル出力する
Next
Close #1
MsgBox "ファイル出力終了"
Exit Sub
'
Macro_Err:
MsgBox "OutPut File Error!"
Exit Sub
'
End Sub
|
