シート削除時の警告を表示しない

昨日、こんなブログを書いてみた。
infoment.hatenablog.com

書いてみて気が付いた。Applicationと書くのが面倒くさいのではなく、
このようにスイッチを切ったり入れたりするのが、実は面倒なんだと。

        ' 警告表示を一時停止。
        Application.DisplayAlerts = False
        ' シート削除。
        Sheet1.Delete
        ' 警告表示一時停止を解除。
        Application.DisplayAlerts = True

そこで、シート削除時の警告を出さない関数を作成してみた。

今回は「AppControl」というクラスモジュールを作成し、そこに詰めてみた。
作戦は以下のとおり。

1. 現状の警告表示設定を記憶。
2. 警告表示を一時停止。
3. シートを削除。
4. 警告表示の一時停止を解除。
5. 最後に、記憶した設定に戻す。

Dim BackupDisplayAlerts As Boolean
Dim TempDisplayAlerts As Boolean
Dim App As Application

Private Sub Class_Initialize()
    Set App = Application
    
    ' インスタンス作成時の設定を退避。
    BackupDisplayAlerts = App.DisplayAlerts
    
End Sub

Public Function SheetDeleteWithoutAlerts(ByVal target_sheet As Variant) As Boolean
    
    On Error GoTo er:
    
    ' 現在の設定を退避。
    TempDisplayAlerts = PresentDisplayAlerts
    
    ' 警告表示を一時停止。
    App.DisplayAlerts = False
    
    Select Case TypeName(target_sheet)
        
        ' シート位置、シート名で指定された場合。
        Case "Integer", "Long", "String"
            Sheets(target_sheet).Delete
        
        ' シートオブジェクトで指定された場合。       
        Case "Worksheet"
            target_sheet.Delete
            
        ' それ以外の場合は処理しない。
        Case Else
            GoTo er:
            
    End Select
    
    ' 削除成功。
    SheetDeleteWithoutAlerts = True
    App.DisplayAlerts = TempDisplayAlerts
    
    Exit Function
    
    ' 削除失敗。
er:
    App.DisplayAlerts = True
    
End Function

' 現在の警告表示設定。
Private Property Get PresentDisplayAlerts() As Boolean
    PresentDisplayAlerts = App.DisplayAlerts
End Property

Private Sub Class_Terminate()
    App.DisplayAlerts = BackupDisplayAlerts
End Sub

なお target_sheet を ByVal にしておかないと、オブジェクト名で渡した場合、
削除後に「型が一致しません」のエラーが発生するようだ（この対策にたどり
着くまでに、随分と時間が掛かった）。場合によってはそのまま異常終了する
こともあるので、注意が必要だ。

ちなみに、動作確認したマクロがこちら。

Sub test()

    Dim ApC As VBAProject.AppControl
    Set ApC = New VBAProject.AppControl
        
        ' シート名で削除。
        ApC.SheetDeleteWithoutAlerts "Sheet4"
        
        ' 左から３番目のシートを削除。
        ApC.SheetDeleteWithoutAlerts 3

        ' オブジェクト名で削除。
        ApC.SheetDeleteWithoutAlerts Sheet2

End Sub

標準モジュール側の行数が、一つも変わっとらんやないか。
でも個人的には、割と気に入ってます。

参考まで。