Excel VBA: как удалить изображения в определенном диапазоне - PullRequest
0 голосов
/ 04 мая 2018

У меня есть макрос, который импортирует данные из выбранного файла. Данные включают в себя несколько изображений. Проблема, с которой я столкнулся, заключается в том, что если в моем документе уже есть данные и изображения, и я иду на импорт новых данных, изображения не удаляются, а просто вставляются друг на друга. Я написал код, чтобы выбрать ячейки и очистить их, но он не очищает изображения.

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

Я наткнулся на решение, которое выбирает все изображения на листе и удаляет их, но у меня есть другие изображения, которые мне нужно сохранить.

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

Ответы [ 2 ]

0 голосов
/ 07 мая 2018

Спасибо. Я тоже сталкивался с этим, но у меня были проблемы с этим. Проведя дополнительные исследования, я смог заставить этот код делать то, что хотел,

Sub DeleteImage()

Dim pic As Picture

ActiveSheet.Unprotect

For Each pic In ActiveSheet.Pictures
    If Not Application.Intersect(pic.TopLeftCell, range("H10:R24")) Is Nothing Then
        pic.Delete
    End If

Next pic

End Sub
0 голосов
/ 05 мая 2018

Быстрый поиск в Google (большинство вопросов задавалось в том или ином месте) дал такой результат. Он использует атрибуты TopLeftCell и BottomRightCell объектов Excel Picture, а затем проверяет, находится ли он внутри диапазона.

Sub test()
'Code by Peter T from https://www.excelbanter.com/excel-programming/404480-select-delete-all-pictures-given-range.html
Dim s As String
Dim pic As Picture
Dim rng As Range

' Set ws = ActiveSheet
Set ws = ActiveWorkbook.Worksheets("Sheet2")

Set rng = ws.Range("A5:C25")

For Each pic In ActiveSheet.Pictures
    With pic
        s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
    End With
    If Not Intersect(rng, ws.Range(s)) Is Nothing Then
        pic.Delete
    End If
Next

End Sub

Я не тестировал этот код, но, тем не менее, он должен предоставить вам достаточно информации для настройки собственного кода.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...