mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Функция для получения всех графических объектов (картинок) в заданном диапазоне ячеек

Функция ShapesInRange предназначена для получения объекта типа ShapeRange, содержащего все картинки в заданном диапазоне ячеек листа Excel

 

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

Sub DeleteShapesInRange()
    Dim ra As Range: Set ra = 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 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

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
    _   _____     _          _____      _ 
(_) | ____| (_) ___ |__ / | |
| | | _| | | / _ \ / / _ | |
| | | |___ | | | __/ / /_ | |_| |
_/ | |_____| _/ | \___| /____| \___/
|__/ |__/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.