Excel終了時にcsvを保存

Question

実現したいこと

【Xxxx.xlsm】を“✕”で閉じると、タイトルバーが【Xxxx.xlsm】から、【Xxxx.csv】へと変わる。
また、所定のフォルダに【Xxxx.csv】が作成される。

【Xxxx.csv】が、変更内容を保存しますか？と聞いてくるので、確認画面なしで【Xxxx.csv】を閉じたい。

また.xlsmの、ThisWorkbookに書いたモジュールに追記する形にしたい。

発生している問題・分からないこと

.Close SaveChanges:=True／False　を使うことで、確認画面を無くすことが出来そうだと分かった。

該当のソースコード

ThisWorkbookに記載。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = False    
    Dim filePath As String    
    ' ファイルの保存先とファイル名を指定
    filePath = "C:\Test\" & Replace(ThisWorkbook.Name, "xlsm", "csv")
    ThisWorkbook.Worksheets("Sheet2").SaveAs Filename:=filePath, FileFormat:=xlCSV
End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

コンパイルエラー等が出てしまった。

補足

特になし

Answer 1

【Xxxx.xlsm】を“✕”で閉じると、タイトルバーが【Xxxx.xlsm】から、【Xxxx.csv】へと変わる。

SaveAs メソッドによって保存された CSV ファイルがそのブック自身（ ThisWorkbook プロパティによって返される Workbook オブジェクト）となるため。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Dim responce As Long
    
    responce = MsgBox("このブックを閉じる前に Sheet2 のコピーをcsvファイルとして保存しますか？", _
                      vbYesNoCancel + vbDefaultButton3 + vbExclamation, _
                      "バックアップ確認")
    
    Select Case responce
        Case vbCancel
            Cancel = True
            Exit Sub
        Case vbNo
            Exit Sub
        Case Else
            '何もしないで処理を継続
    End Select
    
    Dim booksCount As Long
    Dim newBook As Workbook

    With Workbooks
        booksCount = .Count
        ThisWorkbook.Worksheets("Sheet2").Copy
        Do Until booksCount < .Count
            DoEvents
        Loop
        Set newBook = .Item(.Count)
    End With

    Dim filePath As String

    filePath = "C:\Test\" & _
               Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".", -1, vbBinaryCompare) - 1) & ".csv"

    Application.DisplayAlerts = False
    newBook.SaveAs Filename:=filePath, FileFormat:=xlCSV
    newBook.Close
    Set newBook = Nothing
    Application.DisplayAlerts = True

End Sub

Comments

[HAYASHIDA24]

回答ありがとうございます。
試したところ問題が解決しました！
ベストアンサーに選ばせていただきました。