Sub auto_open()

    Application.WindowState = xlMaximized

End Sub

Sub 背景設定()

    Dim strFileName As Variant
    strFileName = Application.GetOpenFilename _
                    (FileFilter:="画像ファイル (*.bmp; *.gif; *.jpg), *.bmp;*.gif;*.jpg", _
                     Title:="背景画像ファイルの指定")
    If strFileName <> False Then
        ActiveSheet.SetBackgroundPicture strFileName        '背景画像の設定
    Else
        ActiveSheet.SetBackgroundPicture ""                   'キャンセルの場合は背景消去
    End If

End Sub

Sub 全ての背景消去()

    Dim ws As Variant
    For Each ws In Worksheets
        Sheets(ws.Name).Select
        Sheets(ws.Name).SetBackgroundPicture ""
    Next
    Sheets(1).Select
    
End Sub

Sub set_passwd()
'
'    このマクロは読み取り専用で開いたファイルに対して実行するとエラーが出ます（同じファイル名でセーブしようとするため）
'    赤字の部分に設定したいパスワードを記述してください
'
    Dim strBookName As String
    
    strBookName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    
    Application.DisplayAlerts = False         '上書き確認のダイアログが出ないようにする
    
    ActiveWorkbook.SaveAs _
        Filename:=strBookName, _
        FileFormat:=xlNormal, _
        Password:="read", _
        WriteResPassword:="write", _
        ReadOnlyRecommended:=False, _
        CreateBackup:=False
    
    Application.DisplayAlerts = True        '上書き確認のダイアログが出る設定に戻す
'
End Sub

Sub Add_RecentFiles()                               '最近使用したファイルにアクティブブックを登録する
'                                                           '既に登録されているファイルを追加した場合はリストの１番に来る
'                                                           '9ファイル登録されている場合には、一番古いリストが削除される
    Dim strBookName As String
    Dim response As Integer
    Dim Flg%
'
    strBookName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

    If Application.DisplayRecentFiles = False Then
        Application.DisplayRecentFiles = True                   '最近使ったファイルの表示をオンにする
        Application.RecentFiles.Maximum = 9                     '表示するファイル数はMAXの９にする
        Flg = 1
    End If
    
    If Flg = 0 Then
        response = MsgBox("追加の前に「最近使用したファイルの一覧」をクリアしますか？" & Chr$(13) & Chr$(13) _
                    , vbYesNo + vbQuestion + vbDefaultButton2, "確認")
        If response = vbYes Then
            Application.DisplayRecentFiles = False
            Application.DisplayRecentFiles = True
            Application.RecentFiles.Maximum = 9
        End If
    End If
            
    response = MsgBox(strBookName & Chr$(13) & Chr$(13) & "を最近使用したファイルの一覧に追加しますか？", _
            vbYesNoCancel + vbQuestion + vbDefaultButton1, "最近使用したファイルの一覧")
    If response = vbYes Then
        Application.RecentFiles.Add Name:=strBookName
    End If
'
End Sub

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
        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