【EXCEL VBA（マクロ）】アクティブシートをテキストファイルで保存する

はじめに（余談）

UTF-8は、多言語に対応したUnicode文字コードのエンコーディング方式の1つで、世界中の多様な言語を扱うことができます。一方、文字コードが異なる場合、文字化けが起こることがあります。

具体的には、CSVファイルをWindowsの標準エンコーディングであるShift-JIS形式で保存した場合、日本語などのマルチバイト文字が含まれる場合に文字化けが起こることがあります。これは、Shift-JIS形式がUnicodeに対応していないためであり、UTF-8形式で保存することで文字化けを防ぐことができます。

また、UTF-8形式で保存することによって、世界中で広く使用されているテキストエディタやWebブラウザなどで文字列を扱うことができ、国際的な相互運用性が高まります。

アクティブシートをテキストデータで保存する

Sub タブ区切り_テキスト保存()
 
    Application.ScreenUpdating = False
    
    Dim shName As String
    shName = ThisWorkbook.ActiveSheet.Name
    
    'アクティブシートを新規ブックにコピー
    ThisWorkbook.ActiveSheet.Copy
    
    '新規ブックをテキスト形式で保存
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    
    Dim nw As String
    nw = VBA.Format(Now, "yyyymmdd " & "hh-mm-ss")

    
    wb.SaveAs _
        FileName:=ThisWorkbook.path & "\" & "【ﾃｷｽﾄ保存】" & nw & ".txt", _
        FileFormat:=xlText
 
    '新規ブックは保存しないで閉じる
    wb.Close savechanges:=False
    
    Application.ScreenUpdating = True
MsgBox "完了_data.txt"
End Sub

アクティブなシートの名前を取得して、shName変数に保存します。
アクティブなシートを新しいブックにコピーします。この新しいブックは、テキスト形式で保存されます。
アクティブなブックをwb変数に格納します。これは、後で新しいブックを閉じるために使用されます。
現在の日付と時刻をnw変数に保存します。ファイル名に日付と時刻を追加するために使用されます。
新しいブックをテキスト形式で保存します。ファイル名は、元のブックと同じ場所に保存され、ファイル名の先頭に「【ﾃｷｽﾄ保存】」というテキストが追加されます。
新しいブックを保存せずに閉じます。
画面の更新を再開します。このコードは、コピー操作や保存操作が完了した後に必要な場合に使用されます。

保存先を指定して、アクティブシートをテキストデータで保存

Sub テキストファイルに保存()

ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs _
FileName:="保存先のファイルパスを記入" & "保存_" & VBA.Format(Now, "yyyymmdd " & "hh-mm-ss"), _
FileFormat:=xlCurrentPlatformText

MsgBox "完了"
End Sub

アクティブシートのセルをループで取得してテキスト保存

Sub Text保存()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet 
Dim nw As String
nw = VBA.Format(Now, "yyyymmdd " & "hh-mm-ss")

Dim datFile As String
datFile = ActiveWorkbook.path & "\" & "【ﾃｷｽﾄ保存】" & nw & ".txt"

Open datFile For Output As #1

Dim i As Long
i = 1
Do While ws.Cells(i, 1).Value <> ""
    'Print #1, ws.Cells(i, 1).Value
    Print #1, ws.Cells(i, 1) & " " & ws.Cells(i, 2) & " " & ws.Cells(i, 3)
    i = i + 1
Loop

Close #1

MsgBox "完了_data.txt"

End Sub

解説

・15行目：テキストに出力するセルを指定する
　＊１列のみループさせる場合：Print #1, ws.Cells(i, 1).Value
　　→3列の場合：のPrint #1, ws.Cells(i, 1) & ” ” & ws.Cells(i, 2) & ” ” & ws.Cells(i, 3)
　　　＊　” ” の間に「”,”（カンマ）」、「” “（スペース）」を記入して指定する

UTF-8でテキストファイル出力

Public Sub TextOutput_UTF8()
Dim i As Integer
 
'ADODB.Streamオブジェクトを生成
Dim ado As Object
Set ado = CreateObject("ADODB.Stream")
 
'ADODB.Streamで扱う文字コードを設定
ado.Charset = "UTF-8"
 
'ADODB.Streamを開く
ado.Open
 
'開いたADODB.Streamに内容を保管
'adWriteLineは改行する時に入れる

For i = 1 To 20
    ado.WriteText Cells(i, 1).Value, adWriteLine
Next
 
'ADODB.Streamに保管されている内容をファイルに保存する
Dim nw As String
nw = VBA.Format(Now, "yyyymmdd " & "hh-mm-ss")

ado.SaveToFile ActiveWorkbook.path & "\" & "【ﾃｷｽﾄ保存】" & nw & ".txt"
 
'ADODB.Streamを閉じる
ado.Close
 
MsgBox "完了"
 
End Sub

ExcelのアクティブなシートをUTF-8形式で保存する

Sub UTF8保存()
Dim shName As String
shName = ThisWorkbook.ActiveSheet.Name

'アクティブシートを新規ブックにコピー
ThisWorkbook.ActiveSheet.Copy

'新規ブックをUTF-8形式で保存
Dim wb As Workbook
Set wb = ActiveWorkbook

Dim nw As String
nw = VBA.Format(Now, "yyyymmdd " & "hh-mm-ss")

wb.SaveAs Filename:=ThisWorkbook.path & "\" & "【UTF-8保存】" & nw & ".txt", _
          FileFormat:=xlUnicodeText, _
          CreateBackup:=False, _
          Local:=True

'新規ブックは保存しないで閉じる
wb.Close savechanges:=False

Application.ScreenUpdating = True

MsgBox "完了"
 
End Sub

ダイアログを開いて保存先を指定してテキスト出力

'テキストファイル出力
Public Sub TextOutput()
Dim i As Integer
Dim folderName As String
 
'ダイアログを開く
folderName = Application.GetSaveAsFilename(FileFilter:="テキストファイル,*.txt")
 
'ファイルを書き込みで開く
Open folderName For Output As #1
 
'開いたファイルに書き込む
For i = 1 To 30
    Print #1, Cells(i, 1).Value
Next
 
'ファイルを閉じる
Close #1
 
 
MsgBox "完了"
 
End Sub

【マクロ・VBA】アクティブシートをテキストデータで保存する