Макрос по избирательному удалению картинок

[Aegi]

Доброго времени суток!
Проблема в следующем - часто копирую страницы из интернета и помещаю их в Excel, вместе с нужными данными копируются и картинки. Картинки делятся на 2 группы - нужные и ненужные. Удалять ненужные даже используя функцию "выбор объекта" всё равно получается утомительно - количество их приближается к тысяче.
Заметил что при переносе в Excel ненужные картинки идут: в одном случае под чётными номерами, во втором под нечётными.
Помогите написать макрос по удалению их согласно чётности/нечётности номера картинки.
Высшим мастерством будет удаление ненужных картинок по их уникальным свойствам например размерам(все ненужные картинки имеют одинаковый отличный от нужных размер).
заранее благодарен.

[Скрипт]

Код работает с активным листом.

Sub Procedure_1()
    
    'В константах указываем нужные размеры рисунка.
    'Если размеры рисунков дробные (например, 100,1), то
        'могут возникнуть проблемы, т.к. в программировании проблемы
        'с использованием дробных чисел. Поэтому, если есть возможность,
        'лучше работать с целыми числами или нужно принудительно округлять 
        'числа, даже если мы видим, что число и так имеет нужный вид.
        'Проблемы могут быть в том, что указанные вами размеры не будут
        'совпадать с размерами рисунков, хотя всё визуально кажется точно.
    'Double - используется для работы с дробными числами.
    'Long - используется для работы с целыми числами.
    Const myWidth As Double = 100
    Const myHeight As Double = 100

    Dim myShape As Excel.Shape
    Dim i As Long
    
    '1. Отключаем обновление монитора, чтобы код быстрее работал.
    Application.ScreenUpdating = False
    
    'Если что-то удаляем, то лучше двигаться с конца в начало,
        'т.к. порядковые номера (и может быть ещё что-нибудь) меняются.
    For i = ActiveSheet.Shapes.Count To 1 Step -1
    
        '2. Даём VBA-имя "myShape" рисунку для удобства написания кода.
            'Через это имя будем управлять рисунком.
        Set myShape = ActiveSheet.Shapes(i)
        
        '3. Узнаём размеры рисунка. Размеры в пунктах.
        If myShape.Width = myWidth And myShape.Height = myHeight Then
            '4. Удаляем рисунок.
            myShape.Delete
        End If
        
    Next i
    
    '5. Включаем обновление монитора.
    Application.ScreenUpdating = True
    
    '6. Сообщение, что работа кода завершена.
    MsgBox "Работа кода завершена.", vbInformation
    
End Sub

[Aegi]

Сразу вопрос (из свойств и размера рисунка) высота 0.64,ширина 0.77 - как правильно записывать в константы? Просто записал как
Const myWidth As Double = 0.77
Const myHeight As Double = 0.64
Числа дробные, действительно проблема - ничего не происходит при выполнении кода.

Может всё таки проще по условию чётности/нечётности удалять?

[EducatedFool]

Размеры задаются в пикселах - соответственно, таких дробных размеров у картинок быть не может.

Поглядите также эту программу для работы с картинками:
http://excelvba.ru/programmes/PastePictures

Она умеет не только вставлять картинки, но и удалять их (как со всего листа, так и из выделенного диапазона ячеек)
Может, получится как-то выделить ячейки, где расположены неподходящие картинки

[Aegi]

Благодарю Скрипта за код(адаптирую его под другие нужды)), EducatedFool - надстройка действительно помогла и решила проблему,вам также спасибо).

[Скрипт]

Aegi, ширина и высота в VBA в данном случае измеряется в пунктах.

[Aegi]

Скрипту

Sub Procedure_1()

Set etShape = ActiveSheet.Shapes("Picture 2")

Dim myShape As Excel.Shape
Dim i As Long

Application.ScreenUpdating = False

For i = ActiveSheet.Shapes.Count To 1 Step -1

Set myShape = ActiveSheet.Shapes(i)

If myShape.Width = etShape.Width And myShape.Height = etShape.Height Then
myShape.Delete
End If

Next i

Application.ScreenUpdating = True

MsgBox "Работа кода завершена.", vbInformation

End Sub

etShape("Picture 2") - ненужная картинка размеры которой использую для условия удаления.
Константы не могу использовать по причине незнания значений высоты и ширины картинки для VB.
Данный макрос работает, но есть один нюанс - когда доходит до сравнение эталона с эталоном и он удаляется, код прерывается из за отсутствия объекта для сравнения.
Подскажите как занести только значения размеров эталона, чтобы даже если он удалён его размеры остались.

[Казанский]

Sub Procedure_1()

Dim myShape As Excel.Shape
Dim i As Long, etWid, etHei

etWid = ActiveSheet.Shapes("Picture 2").Width
etHei = ActiveSheet.Shapes("Picture 2").Height

Application.ScreenUpdating = False

For i = ActiveSheet.Shapes.Count To 1 Step -1

Set myShape = ActiveSheet.Shapes(i)

If myShape.Width = etWid And myShape.Height = etHei Then
myShape.Delete
End If

Next i

Application.ScreenUpdating = True

MsgBox "Работа кода завершена.", vbInformation

End Sub

[Скрипт]

Aegi, размеры рисунка в пунктах можно узнать так:

1. перейдите в программу Excel и кликнете по рисунку, у которого надо узнать размеры;
2. перейдите в программу VBA;
3. View - Immediate Window. Откроется окно;
4. в это окно вставьте этот код и нажмите клавишу "Enter". Будет получена ширина рисунка в пунктах.
   

   print selection.shaperange(1).width

5. удалите из окна код и вставьте этот код. Будет получена высота рисунка в пунктах.
   

   print selection.shaperange(1).height

[Aegi]

Узнал размеры через эти команды, подставил по первому коду всё работает. Огромное спасибо вам Скрипт).