メモ帳に出力

Sub メモ帳に出力()
    Dim 出力文字列 As String
    Dim ファイル名 As String
    Dim ファイル番号 As Integer
    Dim i As Integer
    Dim シート As Worksheet
    
    ' 対象のセルの値を取得
    Set シート = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更
    出力文字列 = "日付：" & シート.Range("B3").Value & vbCrLf
    出力文字列 = 出力文字列 & "天気：" & シート.Range("B6").Value & vbCrLf
    出力文字列 = 出力文字列 & "名前：" & シート.Range("B9").Value & vbCrLf
    出力文字列 = 出力文字列 & "価格：" & シート.Range("B12").Value & vbCrLf
    
    ' 12行目から14行目がある場合は出力
    For i = 12 To 14
        If シート.Cells(i, 2).Value <> "" Then
            出力文字列 = 出力文字列 & "出身地：" & シート.Cells(i, 3).Value & vbCrLf
            出力文字列 = 出力文字列 & "あだ名：" & シート.Cells(i, 4).Value & vbCrLf
            出力文字列 = 出力文字列 & "動物：" & シート.Cells(i, 5).Value & vbCrLf
            出力文字列 = 出力文字列 & "国：" & シート.Cells(i, 6).Value & vbCrLf
        End If
    Next i
    
    ' ファイル名を生成
    ファイル名 = "作成_" & Format(Now(), "yyyymmdd_hhmm") & ".txt"
    
    ' メモ帳に出力
    ファイル番号 = FreeFile
    Open ファイル名 For Output As #ファイル番号
    Print #ファイル番号, 出力文字列
    Close #ファイル番号
    
    ' 保存完了メッセージ
    MsgBox "メモ帳に出力しました。" & vbCrLf & "ファイル名：" & ファイル名 & vbCrLf & "保存場所：" & ThisWorkbook.Path, vbInformation
End Sub