【VBA】ブックに定義されているセルの名前をすべて消す

Sub DeleteCellName(wb As Workbook)

    Dim currentName As Name
    Dim errorNames As Collection
    Set errorNames = New Collection
    Dim message As String
    
    ' ブックに定義されているすべての名前に対して処理を行う
    For Each currentName In wb.Names
        
        ' 印刷関係は無視する
        If InStr(currentName.Name, "Print_Area") = 0 And InStr(currentName.Name, "Print_Titles") = 0 Then
            On Error Resume Next
            
            ' 名前を削除
            currentName.Delete
            
            ' 削除したときにエラーが出たときはコレクションに追加してエラーをリセットする
            If Err.Number <> 0 Then
                errorNames.Add currentName.Name
                Err.Clear
            End If
            On Error GoTo 0
        End If
    Next
    
    ' エラーが出てスルーした名前を表示する
    If errorNames.Count > 0 Then
        For Each Name In errorNames
            message = message & Name & " "
        Next
        message = "以下の名前は手動で削除してください：" & vbCrLf & message
        MsgBox message, vbOKOnly, "エラー"
    End If
    
End Sub

Sub test()

    Call DeleteCellName(ThisWorkbook)

End Sub

On Error Resume Next
            
' 名前を削除
currentName.Delete

' エラーがあればコレクションに追加してエラーをリセットする
If Err.Number <> 0 Then
    errorNames.Add currentName.Name
    Err.Clear
End If

On Error GoTo 0