CSV出力メモ

Sub 印刷()

Dim i As Long, cel As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

i = Range("B2").Value '列数カウント

cel = 4 '列目から

'CSV用定義ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Dim csvFile As String
Dim FileNumber As Integer
Dim ws As Worksheet
'ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Dim wb As String
Dim shp As Shape
Dim box
Dim namae

'出力するファイルのパスとファイル名を指定
csvFile = ActiveWorkbook.Path & "\sample.csv"

FileNumber = FreeFile

Open csvFile For Output As #FileNumber

Do Until i = 0

wb = Cells(cel, 1) 'ワークブック名取得

Workbooks.Open Filename:=Cells(cel, 2), ReadOnly:=True '読み取り専用で開く

'CSV書き出しーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
'CSVファイルへ出力するシートを指定

Set ws = ActiveWorkbook.Worksheets(1)
namae = ActiveWorkbook.Name

Print #FileNumber , """" & namae & """" & ",", ;
Print #FileNumber , """" & ws.Range("A1").Value & """" & ",";
Print #FileNumber , """" & ws.Range("A2").Value & """" & ",";
Print #FileNumber , """" & ws.Range("A3").Value & """" & ",";
Print #FileNumber , """" & ws.Range("C1").Value & """" & ",";
Print #FileNumber , """" & ws.Range("B2").Value & """" & ",";

'テキストボックスの内容を取得*
For Each shp In ActiveWorkbook.ActiveSheet.Shapes
If shp.Type = msoTextBox Then 'テキストボックスのみ処理
box = shp.TextFrame2.TextRange.Text
Print #FileNumber , """" & box & """" & ",";
End If
Next
'****************************************************

Print #FileNumber , vbCr;

Workbooks(wb).Close SaveChanges:=False

cel = cel + 1

i = i - 1

Loop

'ファイルを閉じる
Close #FileNumber

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub