| Top Page | プログラミング | テキスト保存／読み込み |

'ワークブック（ファイル）を読み込み，各ワークシートをそれぞれテキスト形式で保存する．
'
'　　　Coded by TAKENAKA, A. 2005-02-22
'      Revised on 2006-06-11

Sub SaveSheets()

    ver = Application.Version
    If ver * 1 >= 12 Then ' 2007 以降
        file_filter = "Excel File,*.xlsx;*.xlsm,Excel 2003,*.xls"
     Else    ' 2003 以前
        file_filter = "Excel File,*.xls"
     End If

    Target = Application.GetOpenFilename(file_filter)    '  読み込むファイルを選択
    If Target = False Then
        Exit Sub
    End If

    Workbooks.Open Filename:=Target        '  選択したファイルを読み込む
       
    ' 確認のメッセージボックス．
    rvl = MsgBox("全シートをそれぞれテキスト保存？", 33, "作業の確認")
    If (rvl <> vbOK) Then ' [OK] でないなら中止
        Exit Sub
    End If

    Set OriginalBook = ActiveWorkbook  ' 保存したいデータが入ったブックを覚えておく．
    WorkingPath = ActiveWorkbook.Path  ' そのパスも．

    For i = 1 To Sheets.Count  ' ファイル中の各ワークシートについて．

        OriginalBook.Activate ' 保存したいデータが入ったブックをアクティブに．
        Set thisSheet = Sheets(i)
        thisSheet.Activate    ' i 番目のワークシートをアクティブに．
        
        thisSheet.Copy  ' 新しいファイルが作られてシートをコピー．
        newName = WorkingPath + "\" + thisSheet.Name   ' 作製するファイル名．
        ActiveWorkbook.SaveAs Filename:=newName, _
              FileFormat:=xlText, CreateBackup:=False  ' テキスト保存
        ActiveWorkbook.Close SaveChanges:=False        ' ファイルを閉じる．
    Next i

    rvl = MsgBox("読み込んだファイルを閉じますか？", vbYesNo, "テキスト保存終了")
    If rvl = vbYes Then
        OriginalBook.Close  '  ファイルを閉じる
    End If

End Sub