Вставка существующего рисунка (фигуры, другого объекта) в ячейку Excel с помощью кода VBA. Подгон ячейки под размеры рисунка и фигуры под размеры ячейки.
Подгон ячейки под размеры рисунка
Вставка рисунка в ячейку из кода VBA Excel с подгоном размеров ячейки под размеры фигуры (картинки).
Сложность заключается в том, что высота и ширина рисунка (фигуры) и высота ячейки измеряются в точках (пунктах), а ширина ячейки (ширина столбца) измеряется в символах.
Хороший результат при вставке в ячейку небольших изображений дает приравнивание одного символа к пяти точкам.
Код VBA Excel для вставки рисунка в ячейку с подгоном размеров ячейки под размеры фигуры (картинки):
|
Sub Primer1() With Лист20 .Shapes(«Рисунок 1»).Placement = xlMove ‘изменяем ширину ячейки (столбца) в символах до 1/5 ширины рисунка в пунктах .Range(«B3»).ColumnWidth = .Shapes(«Рисунок 1»).Width / 5 ‘изменяем высоту ячейки (строки) до высоты рисунка + 10 точек для отступов .Range(«B3»).RowHeight = .Shapes(«Рисунок 1»).Height + 10 ‘задаем отступ рисунка от левого края ячейки на 5 пунктов .Shapes(«Рисунок 1»).Left = .Range(«B3»).Left + 5 ‘задаем отступ рисунка от верхнего края ячейки на 5 пунктов .Shapes(«Рисунок 1»).Top = .Range(«B3»).Top + 5 End With End Sub |
Свойству Placement объекта Shapes присваиваем значение константы xlMove, которое задает возможность перемещать рисунок вместе с ячейками, но не изменять его размеры при изменении размеров ячеек. Доступные константы из коллекции XlPlacement перечислены ниже.
Было:
Стало:
Подгон фигуры под размеры ячейки
Вставка рисунка в ячейку из кода VBA Excel с подгоном размеров картинки (фигуры) под размеры ячейки.
Чтобы сохранить пропорции рисунка при изменении его высоты до высоты ячейки, ширину картинки будем изменять во столько же раз, во сколько и высоту.
Код VBA Excel для вставки рисунков в ячейки с подгоном размеров картинок (фигур) под размеры ячеек:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Sub Primer2() Dim i As Byte, n As Single For i = 1 To 5 With Лист19 ‘определяем, во сколько раз будет изменена высота рисунка n = .Shapes(i).Height / .Cells(i, 1).Height .Shapes(i).Placement = xlMove ‘изменяем высоту рисунка до высоты ячейки .Shapes(i).Height = .Cells(i, 1).Height ‘изменяем ширину рисунка пропорционально изменению его высоты .Shapes(i).Width = .Shapes(i).Width / n ‘выравниваем рисунок по левому краю ячейки .Shapes(i).Left = .Cells(i, 1).Left ‘выравниваем рисунок по верхнему краю ячейки .Shapes(i).Top = .Cells(i, 1).Top End With Next End Sub |
Было:
Стало:
Константы из коллекции XlPlacement
Константы из коллекции XlPlacement определяют реакцию рисунка, фигуры или другого объекта из группы «Иллюстрации» на перемещение и изменение размеров ячеек, над которыми рисунок расположен.
Описание констант из коллекции XlPlacement:
| Константа | Значение | Описание |
|---|---|---|
| xlMoveAndSize | 1 | Объект перемещается и изменяет размеры вместе с ячейками |
| xlMove | 2 | Объект перемещается вместе с ячейками, но не изменяет размеры |
| xlFreeFloating | 3 | Объект не перемещается и не изменяет размеры вместе с ячейками |
Требуется макросом поместить изображение (картинку) на лист Excel?
Используйте функцию ВставитьКартинку, которая позволит вам вставить картинку в выбранную ячейку (или диапазон ячеек).
При вызове функции можно задать дополнительные дополнительные параметры, указав, следует ли подгонять картинку (или ячейку) по высоте и ширине.
В этом примере демонстрируются возможные варианты применения функции вставки картинок:
Sub ПримерВставкиИзображенийНаЛист() ПутьКФайлуСКартинками = "D:BMPAboutForm.jpg" ' полный путь к файлу изображения ' вставка картинки в ячейку A5 (размеры картинки и ячейки не меняются) ВставитьКартинку Cells(5, 1), ПутьКФайлуСКартинками ' вставка картинки в ячейку F5 (ячейка подгоняется по ШИРИНЕ под картинку) ВставитьКартинку Cells(5, 6), ПутьКФайлуСКартинками, True ' вставка картинки в ячейку E1 (ячейка подгоняется по ВЫСОТЕ под картинку) ВставитьКартинку [e1], ПутьКФайлуСКартинками, , True ' вставка картинки в ячейку F2 (ячейка принимает размеры картинки) ВставитьКартинку Range("F2"), ПутьКФайлуСКартинками, True, True ' ========================================= ' вставка картинки в ячейку F5 (картинка подгоняется по ШИРИНЕ под ячейку) ВставитьКартинку Cells(5, 6), ПутьКФайлуСКартинками, True, , True ' вставка картинки в ячейку E1 (картинка подгоняется по ВЫСОТЕ под ячейку) ВставитьКартинку [e1], ПутьКФайлуСКартинками, , True, True ' вставка картинки в диапазон a2:e3 (картинка вписывается в диапазон) ВставитьКартинку [a2:e3], ПутьКФайлуСКартинками, True, True, True End Sub
А вот и сама функция (скопируйте этот код в стандартный модуль, чтобы иметь возможность вставки картинок одной строкой кода из любого макроса):
Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String, _ Optional ByVal AdjustWidth As Boolean, _ Optional ByVal AdjustHeight As Boolean, _ Optional ByVal AdjustPicture As Boolean = False) ' ========== функция получает в качестве параметров: ==================== ' PicRange - прямоугольный диапазон ячеек, поверх которого будет расположено изображение ' PicPath - полный путь к файлу картинки (файл в формате JPG, BMP, PNG, и т.д.) ' AdjustWidth - если TRUE, то включен режим подбора ширины (подгонка по высоте) ' AdjustHeight - если TRUE, то включен режим подбора высоты (подгонка по ширине) ' AdjustPicture - если TRUE, то подгоняются размеры картинки под ячейку, ' если FALSE (по умолчанию), то изменяются размеры ячейки On Error Resume Next: Application.ScreenUpdating = False ' вставка изображения на лист Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath) ' совмещаем левый верхний угол ячейки и картинки ph.Top = PicRange.Top: ph.Left = PicRange.Left K_picture = ph.Width / ph.Height ' вычисляем соотношение размеров сторон картинки K_PicRange = PicRange.Width / PicRange.Height ' вычисляем соотношение размеров сторон диапазона ячеек If AdjustPicture Then ' ПОДГОНЯЕМ РАЗМЕРЫ ИЗОБРАЖЕНИЯ под ячейку (оптимальный вариант) ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину If AdjustWidth Then ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту If AdjustHeight Then ph.Height = PicRange.Height: ph.Width = ph.Height * K_picture ' AdjustWidth=TRUE и AdjustHeight=TRUE: вписываем картинку в ячейку (без соблюдения пропорций) If AdjustWidth And AdjustHeight Then ph.Width = PicRange.Width: ph.Height = PicRange.Height Else ' ИЗМЕНЯЕМ РАЗМЕРЫ ЯЧЕЙКИ под размеры изображения (нежелательно при вставке НЕСКОЛЬКИХ картинок...) If AdjustWidth Then ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth * ph.Width / PicRange.Cells(1).Width While Abs(PicRange.Cells(1).Width - ph.Width) > 0.1 ' точный подбор ширины ячейки PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width) Wend End If If AdjustHeight Then ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height While Abs(PicRange.Cells(1).Height - ph.Height) > 0.1 ' точный подбор высоты ячейки PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height) Wend End If End If End Sub
|
вставка картинки в ячейку программно |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
I’m adding «.jpg» files to my Excel sheet with the code below :
'Add picture to excel
xlApp.Cells(i, 20).Select
xlApp.ActiveSheet.Pictures.Insert(picPath).Select
'Calgulate new picture size
With xlApp.Selection.ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
'Resize and make printable
With xlApp.Selection
.Placement = 1 'xlMoveAndSize
'.Placement = 2 'xlMove
'.Placement = 3 'xlFreeFloating
.PrintObject = True
End With
I don’t know what I am doing wrong but it doesn’t get inserted into the right cell, so what should I do to put this picture into a specified cell in Excel?
SWa
4,32323 silver badges40 bronze badges
asked Oct 17, 2012 at 14:29
Berker YüceerBerker Yüceer
6,98618 gold badges67 silver badges102 bronze badges
2
Try this:
With xlApp.ActiveSheet.Pictures.Insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
.Left = xlApp.ActiveSheet.Cells(i, 20).Left
.Top = xlApp.ActiveSheet.Cells(i, 20).Top
.Placement = 1
.PrintObject = True
End With
It’s better not to .select anything in Excel, it is usually never necessary and slows down your code.
answered Oct 17, 2012 at 14:42
1
Looking at posted answers I think this code would be also an alternative for someone. Nobody above used .Shapes.AddPicture in their code, only .Pictures.Insert()
Dim myPic As Object
Dim picpath As String
picpath = "C:Usersphoto.jpg" 'example photo path
Set myPic = ws.Shapes.AddPicture(picpath, False, True, 20, 20, -1, -1)
With myPic
.Width = 25
.Height = 25
.Top = xlApp.Cells(i, 20).Top 'according to variables from correct answer
.Left = xlApp.Cells(i, 20).Left
.LockAspectRatio = msoFalse
End With
I’m working in Excel 2013. Also realized that You need to fill all the parameters in .AddPicture, because of error «Argument not optional». Looking at this You may ask why I set Height and Width as -1, but that doesn’t matter cause of those parameters are set underneath between With brackets.
Hope it may be also useful for someone 
answered Oct 22, 2019 at 9:17
TeamothyTeamothy
1,9903 gold badges15 silver badges24 bronze badges
If it’s simply about inserting and resizing a picture, try the code below.
For the specific question you asked, the property TopLeftCell returns the range object related to the cell where the top left corner is parked. To place a new image at a specific place, I recommend creating an image at the «right» place and registering its top and left properties values of the dummy onto double variables.
Insert your Pic assigned to a variable to easily change its name. The Shape Object will have that same name as the Picture Object.
Sub Insert_Pic_From_File(PicPath as string, wsDestination as worksheet)
Dim Pic As Picture, Shp as Shape
Set Pic = wsDestination.Pictures.Insert(FilePath)
Pic.Name = "myPicture"
'Strongly recommend using a FileSystemObject.FileExists method to check if the path is good before executing the previous command
Set Shp = wsDestination.Shapes("myPicture")
With Shp
.Height = 100
.Width = 75
.LockAspectRatio = msoTrue 'Put this later so that changing height doesn't change width and vice-versa)
.Placement = 1
.Top = 100
.Left = 100
End with
End Sub
Good luck!
answered Mar 14, 2017 at 3:40
FCastroFCastro
5916 silver badges7 bronze badges
1
I have been working on a system that ran on a PC and Mac and was battling to find code that worked for inserting pictures on both PC and Mac. This worked for me so hopefully someone else can make use of it!
Note: the strPictureFilePath and strPictureFileName variables need to be set to valid PC and Mac paths Eg
For PC: strPictureFilePath = «E:Dropbox» and strPictureFileName = «TestImage.jpg» and with Mac: strPictureFilePath = «Macintosh HD:Dropbox:» and strPictureFileName = «TestImage.jpg»
Code as Follows:
On Error GoTo ErrorOccured
shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Select
ActiveSheet.Pictures.Insert(Trim(strPictureFilePath & strPictureFileName)).Select
Selection.ShapeRange.Left = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Left
Selection.ShapeRange.Top = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Top + 10
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 130
answered Jul 17, 2016 at 9:31
TristanTristan
1632 silver badges10 bronze badges
Firstly, of all I recommend that the pictures are in the same folder as the workbook.
You need to enter some codes in the Worksheet_Change procedure of the worksheet. For example, we can enter the following codes to add the image that with the same name as the value of cell in column A to the cell in column D:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pic As Picture
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
On Error GoTo son
For Each pic In ActiveSheet.Pictures
If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 3).Address)) Is Nothing Then
pic.Delete
End If
Next pic
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 2).Top
Selection.Left = Target.Offset(0, 3).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height
Selection.ShapeRange.Width = Target.Offset(0, 3).Width
son:
End Sub
With the codes above, the picture is sized according to the cell it is added to.
Details and sample file here : Vba Insert image to cell
answered Jan 24, 2021 at 18:06
kadrleynkadrleyn
3341 silver badge5 bronze badges
1
I tested both @SWa and @Teamothy solution. I did not find the Pictures.Insert Method in the Microsoft Documentations and feared some compatibility issues. So I guess, the older Shapes.AddPicture Method should work on all versions. But it is slow!
On Error Resume Next
'
' first and faster method (in Office 2016)
'
With ws.Pictures.Insert(Filename:=imageFileName, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = destRange.Width
.height = destRange.height '222
End With
.Left = destRange.Left
.Top = destRange.Top
.Placement = 1
.PrintObject = True
.Name = imageName
End With
'
' second but slower method (in Office 2016)
'
If Err.Number <> 0 Then
Err.Clear
Dim myPic As Shape
Set myPic = ws.Shapes.AddPicture(Filename:=imageFileName, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=destRange.Left, Top:=destRange.Top, Width:=-1, height:=destRange.height)
With myPic.OLEFormat.Object.ShapeRange
.LockAspectRatio = msoTrue
.Width = destRange.Width
.height = destRange.height '222
End With
End If
answered Jan 31, 2020 at 15:06
DrMarbuseDrMarbuse
77410 silver badges30 bronze badges
1
Уже несколько лет в Google Sheets существует функция IMAGE, позволяющая вставлять в ячейки листа картинки по ссылке из интернета. Что, впрочем, вполне естественно, поскольку Google-таблицы изначально заточены под работу онлайн — им сам бог велел такую возможность использовать.
У Excel же ничего подобного долго не было. И вот, наконец, осенью 2022 года Microsoft начала среди добровольцев-тестировщиков из программы Office Insider обкатку своего аналога — новой функции ИЗОБРАЖЕНИЕ (IMAGE), также позволяющей вставлять по веб-ссылке картинки из интернета прямо в ячейки листа Microsoft Excel. В начале 2023 года эту функцию уже стали потихонечку разливать с обновлениями подписчикам Office 365 и недавно она, наконец, добралась и до меня. А значит я могу вам о ней рассказать на нескольких практических примерах.
Если же последней версии Office у вас пока (или уже) не предвидится, то не расстраивайтесь — в конце этой статьи я покажу как при помощи короткого макроса можно сделать упрощённый аналог этой функции уже сегодня.
Синтаксис функции ИЗОБРАЖЕНИЕ (IMAGE)
Тут всё предельно просто:
=ИЗОБРАЖЕНИЕ(источник; [замещающий_текст]; [изменение_размера]; [высота]; [ширина])
Первым и единственным обязательным аргументом новой функции должна быть текстовая ссылка на файл изображения из интернета. Причем это должна быть именно веб, а не локальная ссылка на файл на жестком или сетевом диске. Если доступа в интернет сейчас нет, то вместо картинки будет ошибка #СОЕДИНЕНИЕ! (если нет интернета) или #ЗАБЛОКИР! (если ваши настройки безопасности не дают загрузить картинку). Если вы хотите подстраховаться на такой случай, то вторым аргументом как раз можно ввести замещающий текст, который будет отображен вместо отсутствующей картинки.
Третий аргумент отвечает за размеры и пропорции изображения и может принимать значения:
- 0 — вписать изображение в ячейку с сохранением пропорций
- 1 — заполнить всю площадь ячейки не сохраняя пропорции картинки
- 2 — сохранить исходный размер изображения (тут оно запросто может вылезти за пределы ячейки)
- 3 — задать высоту и ширину изображения принудительно (тогда их надо обязательно прописать в четвертом и пятом аргументе функции)
Большим преимуществом новой функции является то, что картинка будет не просто вставлена на лист, а именно вписана в конкретную ячейку, т.е. будет вместе с ней двигаться, сжиматься и растягиваться. Это принципиально отличается от классической вставки картинок командой Вставка — Рисунки (Insert — Pictures), когда изображение и лист находились, по сути, в разных слоях и вы могли запросто случайно сдвинуть или даже удалить картинку после вставки. Здесь же всё чётко.
Также если щёлкнуть по вставленному функцией изображению правой кнопкой мыши и выбрать команду Показать сведения об изображении (Show image properties), то во всплывающем окне можно будет увидеть картинку в оригинальном разрешении.
Теперь давайте рассмотрим несколько вкусных примеров использования новой функции ИЗОБРАЖЕНИЕ на практике.
Пример 1. Создание штрих-кодов и QR-кодов
Этикетки для маркировки товаров, ценники, бланки, наклейки — всё это требует формирования штрих-кодов различного типа. Теперь для этого можно не использовать специальные программы, а реализовать всё в Excel.
Идём на сайт австрийской компании TEC-IT, где можно легко создать штрих-код любого стандарта с заданным содержимым:
Ссылка, по которой формируется изображение штрих-кода висит на кнопке Download и выглядит так:
_ttps://barcode.tec-it.com/en/Тип_штрихкода?data=Наше_содержимое_кода
Например, для распространенного типа Code-128, который кодирует строку «ABC-abc-1234» ссылка будет выглядеть как:
_ttps://barcode.tec-it.com/en/Code128?data=ABC-abc-1234
Так что просто подклеиваем справа от последнего знака «равно» наши артикулы, заворачиваем всё в функцию ИЗОБРАЖЕНИЕ и получаем автоматизированное создание штрих-кодов для любого количества товаров:
Красота.
Если нужен не линейный, а квадратный QR-код, то можно использовать другой бесплатный сайт — QR Code Generator:
Здесь ссылка для формирования QR-кода выглядит следующим образом:
ttps://api.qrserver.com/v1/create-qr-code/?data=Наши_данные&size=100×100
Опять же, подставляем туда адреса ячеек с исходными данными и получаем возможность массово клепать QR-коды в любом количестве:
Пример 2. Логотипы компаний
Ещё одна любопытная возможность — это автоматизированная загрузка логотипов известных компаний с помощью веб-сервиса https://logo.clearbit.com. Идея та же — подклеиваем адрес сайта нужной нам компании в конец ссылки — и получаем от сервиса изображение логотипа заданной компании, которое выводит на лист наша функция ИЗОБРАЖЕНИЕ:
Можно использовать в дашбордах по анализу рынка, для визуализации инвестиционного портфеля, в прайс-листах и т.д. — у кого на сколько фантазии хватит.
Пример 3. Нестандартные диаграммы
На сайте QuickChart.io можно в режиме онлайн-конструктора создавать разнообразные диаграммы по вашим данным и использовать их затем в ваших проектах. Нюанс в том, что помимо стандартных диаграмм (которые Excel и сам неплохо умеет строить), здесь есть несколько весьма симпатичных нестандартных, например, спидометры и прогресс-бары, диаграммы Санкей для визуализации связей и т.д.
Для получения, например, круговой диаграммы-шкалы прогресса, нам потребуется сформировать вот такую веб-ссылку:
ttps://quickchart.io/chart?c={type:’radialGauge’,data:{datasets:[{data:[Значение_параметра],backgroundColor:’green’}]}}
И визуализировать её затем с помощью нашей новой функции ИЗОБРАЖЕНИЕ (IMAGE):
Или можно, например, сформировать и вывести изображение вот такого нарядного спидометра со стрелкой:
Здесь ссылка чуть похитрее, т.к. в неё уже зашиты размеры трёх диапазонов шкалы и их цвета, а также положение стрелки:
ttps://quickchart.io/chart?c={ type: ‘gauge’, data: { datasets: [ { data: [10, 40, 60], value: Позиция_стрелки, backgroundColor: [‘green’, ‘gold’, ‘lightcoral’] } ] } }
Названия цветов для заливки сегментов диаграммы можно взять из справочника.
Пример 4. Скриншоты сайтов
Если вы работаете с интернет-ресурсами или в области SEO-SMM, то вам пригодится возможность быстро формировать скриншоты заданных веб-страниц и вставлять их на лист Excel в виде изображений. Это можно сделать с помощью веб-сервиса https://mini.s-shot.ru, добавив к его адресу ссылку на интересующую страницу.
Подставляем её в нашу функцию ИЗОБРАЖЕНИЕ и получаем:
При большом количестве ссылок и скриншотов вся эта история может первый раз ощутимо подтормаживать — не пугайтесь.
Пример 5. Географические карты
Опять же, вставлять на лист интерактивные географические карты Excel уже давно умеет (через Вставка — Карты Bing, например), но можно это сделать и с помощью новой функции ИЗОБРАЖЕНИЕ, если найти веб-сервис, который по заданным координатам или названию населенного пункта будет формировать для нас скриншот карты в нужном месте. Обычно такие сервисы платные и используют API — специальный механизм запросов для общения с ними.
Например, на одном из таких сайтов Geoapify.com ссылка для получения нужного фрагмента карты случае формируется из:
- долготы (longtitude)
- широты (latitude)
- коэффициента масштаба (zoom)
- ключа API — длинного буквенно-цифрового кода, который вы получаете в личном кабинете в качестве вашего личного идентификатора:
Обратите внимание, что в качестве разделителя между целой и дробной частью должна быть использована точка, поэтому дополнительно придётся использовать функцию ПОДСТАВИТЬ (SUBSTITUTE), чтобы её подменить.
Аналог функции IMAGE на VBA
Если приведенные выше примеры вас заинтриговали, но последней версии Excel у вас пока нет, то можно относительно легко склепать на коленке упрощенный аналог этой функции на Visual Basic. Только вставлять картинки он будет не по ссылке из интернета, а по пути к файлу с жесткого диска вашего ПК (что в некоторых случаях может быть даже предпочтительнее — интернет у нас не везде бывает).
Откройте редактор макросов сочетанием клавиш Alt+F11 или кнопкой Visual Basic на вкладке Разработчик (Developer). Вставьте новый пустой модуль командой меню Insert — Module и скопируйте туда текст следующего макроса:
Sub InsertPictures()
Dim pic As Shape
Dim cell as Range, imageCell as Range
'проходим по выделенным непустым ячейкам
For Each cell In Selection
If Not IsEmpty(cell) Then
Set imageCell = cell.Offset(0, 1) 'определяем ячейку справа для вставки картинки
'вставляем картинку
Set pic = ActiveSheet.Shapes.AddPicture(cell.Value, False, True, imageCell.Left, imageCell.Top, -1, -1)
pic.LockAspectRatio = True 'фиксируем соотношение сторон
pic.Height = imageCell.Height 'подгоняем по высоте под ячейку
End If
Next cell
End Sub
Теперь останется ввести в ячейки листа пути к файлам картинок, а затем выделить эти ячейки и запустить наш макрос командой Разработчик — Макросы (Developer — Macros) или сочетанием клавиш Alt+F8. Макрос пробежит по всем выделенным ячейкам и вставит в каждую картинку из указанного файла, вписав её в по размерам в каждую ячейку.
Картинки, правда, будут не внутри ячеек, как в случае с функцией IMAGE, а — как обычно — в отдельном слое, так что изменение высоты строк не приведёт к автоматической подгонке размеров изображений.
Если нужно будет подгонять размер картинок не по высоте, а по ширине ячеек, то замените в коде свойство Height на Width.
Ссылки по теме
- Выпадающий список с показом изображений
- Картинка в примечании к ячейке
- Создание печатной подложки в Excel