MyTetra Share
Делитесь знаниями!
DeleteShapes
Время создания: 16.03.2019 23:43
Текстовые метки: Shapes
Раздел: Разные закладки - VBA - Excel - Shapes
Запись: xintrea/mytetra_db_adgaver_new/master/base/148240453338nta32chl/text.html на raw.githubusercontent.com

'Пример использования функции ShapesInRange:

Sub DeleteShapesInRange()

Dim ra As Range: Set ra = Selection 'Range("G5:I33") 'Columns(6)

' задаём диапазон для поиска картинок

On Error Resume Next 'на случай, если картинок в заданном диапазоне нет

ShapesInRange(ra).Delete

' удаляем все картинки в диапазоне ra

End Sub

'Код функции ShapesInRange:

Function ShapesInRange(ByRef ra As Range) As ShapeRange

On Error Resume Next: Dim a(), i&, n&, Shps As Shapes

Set Shps = ra.Worksheet.Shapes

If Shps.Count = 0 Then Exit Function

ReDim a(1 To Shps.Count)

For i = 1 To Shps.Count

With Shps.Item(i)

' If .Type = msoPicture Or .Type = msoLinkedPicture Then

If .Type = 1 Then

If Not Intersect(ra.Worksheet.Range(.TopLeftCell, .BottomRightCell), ra) Is Nothing Then

n = n + 1: a(n) = i

End If

End If

End With

Next

If n Then ReDim Preserve a(1 To n): Set ShapesInRange = Shps.Range(a)

End Function

'Для удаления картинок в выделенном диапазоне ячеек, код вызова функции будет таким:

Sub DeleteShapesInSelection()

On Error Resume Next ' на случай, если картинок в заданном диапазоне нет

ShapesInRange(Selection).Delete ' находим и удаляем все картинки в выделенном диапазоне

End Sub

Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования