Исходный текст

Option Explicit
Call EraseTestStatuses()


'==============================================================================
' Удалить все тестовые статусы
'==============================================================================
Sub EraseTestUsers()
        
        Dim  AllAppObjects, testdesc, i
        'Если нет информации о статусах, выйти из процедуры
        If ThisApplication.Statuses.Count = 0 Then 
                MsgBox "Статусы в системе отсутствуют.", _
                        vbInformation, "Информация о текущей настройке"
                Exit Sub
        End If

        
        Set AllAppObjects = ThisApplication.Statuses ' Получить коллекцию статусов
        With AllAppObjects
            testdesc = "Тестовый статус"
            For i = 0 to .Count - 1
                    if .Item(i).Description = testdesc Then
                        .Item(i).Erase
                    End If
            Next
        End With
End Sub 
'==============================================================================