Excel - Макрос для вставки картинок в лист
- вопрос
- Решение
вопрос
Я пытаюсь вставить изображения в столбец Excel, используя макрос, который берет ссылку на имя файла из ячейки B2 и вставляет изображение в ячейку A2. Например: если B2 содержит N235, то изображение, которое будет вставлено в A2, будет N235.jpg по указанному пути в макросе. Это работает нормально, кроме случаев, когда в папке нет изображения с тем же именем, что и в папке.- Я получаю ошибку времени выполнения 1004, и макрос останавливается и не может заполнить изображение после этой ячейки.
Решение
Sub Picture ()Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
lThisRow = 2
Делать Пока (Клетки (lThisRow, 2) "")
pasteAt = lThisRow
Ячейки (pasteAt, 1). Выберите 'Это где изображение будет вставлено
picname = Cells (lThisRow, 2) 'Это имя картинки
present = Dir ("C: \ Users \ Администратор \ Desktop \ LC \" & picname & ".jpg")
Если присутствует "" Тогда
ActiveSheet.Pictures.Insert ("C: \ Users \ Administrator \ Desktop \ LC \" & picname & ".jpg"). Выберите 'Путь к месту хранения изображений
«» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «»»
Это меняет картину
«» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «» «»»
С выбором
'.Left = Range ("A6"). Слева
'.Top = Range ("A6"). Top
.Left = Cells (pasteAt, 1) .Left
.Top = Клетки (pasteAt, 1) .Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100 #
.ShapeRange.Width = 130 #
.ShapeRange.Rotation = 0 #
Конец с
еще
Ячейки (pasteAt, 1) = "Изображение не найдено"
End If
lThisRow = lThisRow + 1
петля
Range ( "A10"). Выберите
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
MsgBox "Невозможно найти фотографию" 'Отображает окно сообщения, если изображение не найдено
Exit Sub
Range ( "B20"). Выберите
End Sub
Спасибо rizvisa1 за этот совет.