Исходный текст
Option Explicit
Call EraseTestObjects()
'==============================================================================
' Удалить все тестовые объекты
'==============================================================================
Sub EraseTestObjects()
Dim AllAppObjects, testdesc, i
Set AllAppObjects = ThisApplication.Desktop.Objects ' Получить коллекцию объектов
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
Next
End With
End Sub
'==============================================================================