Исходный текст
Option Explicit
Call EraseTestIcons()
'==============================================================================
' Удалить все тестовые иконки
'==============================================================================
Sub EraseTestIcons()
Dim AllAppObjects, testdesc, i
Set AllAppObjects = ThisApplication.Icons ' Получить коллекцию иконок
On Error Resume Next
With AllAppObjects
'Если нет информации об иконках, выйти из процедуры
If .Count = 0 Then
MsgBox "Иконки в системе отсутствуют.", _
vbInformation, "Информация о текущей настройке"
Exit Sub
End If
testdesc = "Тестовая иконка"
For i = 0 to .Count - 1
if .Item(i).Description = testdesc Then
.Item(i).Erase
End If
If Err.Number <> 0 Then
Application.MessageBox _
"Невозможно удалить системную иконку!"
Err.Clear
End If
Next
End With
On Error Goto 0
End Sub
'==============================================================================