CSV化

Sub SavePrintAreaAsCSV()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim printRange As Range
    Dim newWorkbook As Workbook
    Dim newWorksheet As Worksheet
    Dim filePath As String
    Dim currentDate As String
    Dim customFileName As String

    ' アクティブシートを設定
    Set ws = ActiveSheet
    
    ' A列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 印刷範囲をA列からG列まで設定
    Set printRange = ws.Range("A1:G" & lastRow)
    ws.PageSetup.PrintArea = printRange.Address

    ' 作成日をyyyymmdd形式で取得
    currentDate = Format(Date, "yyyymmdd")

    ' 任意のファイル名を入力
    customFileName = InputBox("保存するファイル名を入力してください（拡張子は不要）:")

    ' 保存先のパスを指定（ファイル名に作成日を追加）
    filePath = "C:\path\to\your\directory\" & customFileName & "_" & currentDate & ".csv"

    ' 新しいワークブックを作成
    Set newWorkbook = Workbooks.Add
    Set newWorksheet = newWorkbook.Sheets(1)

    ' 印刷範囲を新しいワークシートにコピー
    printRange.Copy Destination:=newWorksheet.Range("A1")

    ' 新しいワークブックをCSV形式で保存
    newWorkbook.SaveAs Filename:=filePath, FileFormat:=xlCSV, CreateBackup:=False
    newWorkbook.Close SaveChanges:=False

    ' メッセージ表示
    MsgBox "CSVファイルが保存されました: " & filePath
End Sub