|
|||||||
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 |
|||||||
Так же в этом разделе:
|
|||||||
|
|||||||
|