ファイルを閉じる際の確認ダイアログを無視する|VBA

ファイルを閉じる際の保存確認

VBAで開いたExcelファイルを閉じる場合に変更があれば確認ダイアログが表示されます。
このダイアログを表示せずに無条件でファイルを閉じたる(変更を保存しない)方法です。
Application.DisplayAlertsを一時的にFalseにします。

保存確認するソースコード
Option Explicit

Sub Main()
    ' ブックを開く
    Dim openBook As Workbook
    Dim fileName As String
    fileName = Application.GetOpenFilename("Excel ブック,*.xls; *.xlsx")
    If fileName <> "False" Then
        Set openBook = Workbooks.Open(fileName)
    Else
        Exit Sub
    End If

    Cells(1, 1).Value = "1"

    ' ブックを閉じる.
    openBook.Close
End Sub
保存確認ダイアログ
保存確認しないソースコード
Option Explicit

Sub Main()
    ' ブックを開く
    Dim openBook As Workbook
    Dim fileName As String
    fileName = Application.GetOpenFilename("Excel ブック,*.xls; *.xlsx")
    If fileName <> "False" Then
        Set openBook = Workbooks.Open(fileName)
    Else
        Exit Sub
    End If

    Cells(1, 1).Value = "1"

    ' ブックを閉じる.
    Application.DisplayAlerts = False ' 保存確認させない.
    openBook.Close
    Application.DisplayAlerts = True ' 保存確認する.
End Sub

名前を付けて保存時の上書き確認

名前を付けて保存(ActiveWorkbook.SaveAs)する場合に既に同名のファイルがあれば確認ダイアログが表示されます。
このダイアログを表示せずに無条件でファイルを保存(上書き保存)したい場合も、Application.DisplayAlertsを一時的にFalseにします。
なお、上書き保存(ActiveWorkbook.Save)では確認ダイアログは表示されません。

上書き確認するソースコード
Option Explicit

Sub Main()
    ' ブックを開く
    Dim openBook As Workbook
    Dim fileName As String
    fileName = Application.GetOpenFilename("Excel ブック,*.xls; *.xlsx")
    If fileName <> "False" Then
        Set openBook = Workbooks.Open(fileName)
    Else
        Exit Sub
    End If

    Cells(1, 1).Value = "1"

    Dim saveBookName As String
    saveBookName = "new_" & openBook.name

    ' 新規ファイル保存
    ActiveWorkbook.SaveAs (openBook.Path & "\" & saveBookName)
    openBook.Close
End Sub
上書き確認ダイアログ
上書き確認しないソースコード
Option Explicit

Sub Main()
    ' ブックを開く
    Dim openBook As Workbook
    Dim fileName As String
    fileName = Application.GetOpenFilename("Excel ブック,*.xls; *.xlsx")
    If fileName <> "False" Then
        Set openBook = Workbooks.Open(fileName)
    Else
        Exit Sub
    End If

    Cells(1, 1).Value = "1"

    Dim saveBookName As String
    saveBookName = "new_" & openBook.name

    ' 新規ファイル保存
    Application.DisplayAlerts = False ' 上書き確認せずに強制上書き.
    ActiveWorkbook.SaveAs (openBook.Path & "\" & saveBookName)
    Application.DisplayAlerts = True ' 上書き確認する.
    openBook.Close
End Sub
このエントリーをはてなブックマークに追加
にほんブログ村 IT技術ブログへ

コメント

メールアドレスが公開されることはありません。 が付いている欄は必須項目です