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

Вставка картинок и изображений в ячейки листа Excel

Требуется макросом поместить изображение (картинку) на лист Excel?

Используйте функцию ВставитьКартинку, которая позволит вам вставить картинку в выбранную ячейку (или диапазон ячеек).

При вызове функции можно задать дополнительные дополнительные параметры, указав, следует ли подгонять картинку (или ячейку) по высоте и ширине.

Если вам требуется вставлять много изображений на лист Excel, - то вам поможет надстройка, позволяющая производить поиск изображений в заданной папке, и производить вставку картинок в ячейки или примечания

Кроме того, надстройка для вставки изображений в Excel умеет загружать картинки из интернета (по ссылкам в таблице Excel)

Бесплатно скачать надстройку вставки картинок в Excel

В этом примере демонстрируются возможные варианты применения функции вставки картинок:

Sub ПримерВставкиИзображенийНаЛист()
 
    ПутьКФайлуСКартинками = "D:\BMP\AboutForm.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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Я в Excel не особый знаток, мне как раз нужен макрос по вставке фото в лист. Но я не знаю как отредактировать Ваш макрос. Т.е. там многое написано по-русски (не учитывая комментарии). Если просто вставить ваш код в исходный код Excel, то ничего не работает. Помогите пожалуйста разобраться! Спасибо!

Спасибо большое! Буду пробовать

Если в макросах не разбираетесь достаточно, - то со сжатием картинок там намного сложнее,
имеет смысл всё-таки использовать готовое решение.

Сжатие (изменение размеров графического файла перед вставкой картинки):
http://excelvba.ru/code/ResizeImages

PS: можно назначить макросам из моей надстройки (PastePictures) горячие клавиши.
Пока штатными средствами надстройки этого не добиться, - но, если надо, - могу реализовать в следующих версиях.

Спасибо большое! Я к сожалению не обладаю особыми знаниями, чтобы изменять и подстраивать команды...
Вашей программой с надстройками я уже успешно пользуюсь, но все же мне хочется упростить процесс нажатием горячих клавиш.
Не могли бы Вы мне еще подсказать команду для сжатия вставляемой фотографии?

Здравствуйте, Леонид.
Этот вопрос уже неоднократно задавался в комментариях:
http://excelvba.ru/code/PastePictures#comment-2628

Для Excel 2010 нужен другой способ вставки картинок, более сложный: не Pictures.Insert, а Shapes.AddPicture

Sub ВставкаКартинкиВВыделенныйДиапазонЯчеек()
    PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , False)
    If PicLocation = False Then Exit Sub        ' если отказ от выбора файла

    With ActiveSheet.Shapes.AddPicture(PicLocation, msoFalse, msoCTrue, 0, 0, 0, 0)
        .Top = Selection.Top
        .Left = Selection.Left
        .Width = Selection.Width
        .Height = Selection.Height
    End With
End Sub

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

Доброго времени суток!
Помогите мне пожалуйста с макросом. Данный макрос прекрасно работает в Excel 2003, но в 2010-м Excel все не так, при переносе файла в ячейках вылетают ссылки. Помогите пожалуйста адаптировать данный код под 2010 Excel

    PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , "False")
    ActiveSheet.Pictures.Insert(PicLocation).Select
    Selection.ShapeRange.ScaleWidth 0.12, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.12, msoFalse, msoScaleFromTopLeft

Здравствуйте, Марина
Сами по себе картинки не уменьшатся, независимо от того, какой метод вставки вы выбираете.
Есть в Excel встроенная возможность сжать картинки, - но это, пожалуй, то единственное действие, которое программно (средствами VBA) выполнить не получится.

Моя программа использует функции WinAPI для создания уменьшенных картинок, перед вставкой на лист.
Там очень много взаимосвязанного кода (т.к. программа универсальная, и содержит кучу настроек)
Потому просто скопировать тот код из надстройки не получится.
Кроме того, я пишу макросы только для Excel, и как поведет себя этот код в 1С, - представления не имею.
Поэтому не возьмусь вам помочь.

Вариант решения проблемы, макросом из 1С:
1) запускаете Excel в скрытом режиме
2) в нём открываете созданный файл Excel и мою надстройку
3) программно запускаете макрос вставки картинок (можно перед этим программно изменить настройки вставки)
4) закрываете Excel

PS: Можете сами попробовать написать код.
Все необходимое для него есть здесь: http://excelvba.ru/code/ResizeImages
(это как раз код из моей надстройки. Вам нужен макрос «ИзменениеРазмеровКартинки»)

Здравствуйте. Мне не помог метод AddPicture с нулями. Файл по-прежнему большой создается. Возможно ли заказать у Вас изменение этого макроса, так, чтобы картинки вставлялись не ссылками и ужимались? Так, как это делает Ваша надстройка? И сколько это стоить будет?

Да, я все из 1С делаю. Когда выводила прайс с помощью AddPicture, получался файл 6 метров, когда заполняла картинки того же файла с помощью вашей надстройки - 3 метра.
Вообще использовала AddPicture с параметрами сразу установленными, попробую с нулями. Большое спасибо за ответы! А то я ни разу не VBA-программист.

Вы макрос из 1С запускаете? Т.е. вставка картинок и отправка, - всё из 1С?
(если в Excel, то можно программно управлять моей надстройкой, запуская из неё команду вставки картинок. но это только при работе с макросом из Excel)

Да, надо использовать AddPicture с параметрами 0,0,0,0
а потом позиционировать картинку на листе, и выставлять нужные размеры.

Насчёт размера картинок, - AddPicture точно такие же картинки вставляет, вроде бы
Так что размер создаваемого файла Excel от метода вставки картинок не зависит.

Да, программа хорошо вставляет) Но мне нужно формировать файл и отсылать клиентам по кнопочке, чтобы пользователи даже не заходили в Excel. Я еще пробовала метод AddPicture, но файл большой получается, он, видимо, не сжимает картинку при вставке. Т.е. не судьба, или можно еще что-то попробовать?

Здравствуйте, Марина.

Да, есть такая проблема, - по умолчанию, в Excel 2010 картинки вставляются связанными с файлами
(если использовать метод вставки Pictures.Insert)

Есть другие способы вставки картинок, - но там сложнее позиционировать картинку относительно ячейки.

В универсальной программе вставки картинок в Excel эта проблема решена, - вставленные с её помощью картинки сохраняются вместе с файлом, и можно смело рассылать файл с картинками.
Кроме того, в этой программе есть опция сжатия картинок, - что тоже немаловажно.

Здравствуйте! Я использовала Ваш макрос для вывода картинок из 1с в Excel. Но при удалении каталога с картинками вместо картинок отображается сообщение "Не удается отобразить связанный рисунок". А мне нужно файл клиентам отсылать. Что я не так делаю? Подскажите, пожалуйста!

Подскажите, пожалуйста.
Если файл Excel является общим, как тогда вставлять картинку?
Посредством данной функции вставка не происходит.

Александр, а какое отношение ваш вопрос имеет к теме статьи (к вставке картинок на лист Excel)?
Обратитесь на форумы по Excel - там вам подскажут.

как уменьшить текс в exele и копировать в word

Здравствуйте,
можете ли подсказать какими макрокомандами можно менять положение желтого ромбика на вставленный кубик? (msoShapeCube)

Картинка меняется - код вроде правильный.
Вот только пока макрос не закончит свою работу, Excel может не обновлять картинку на элементе Image1
(вроде как-то сталкивался с подобным)
Т.е. только когда цикл завершился, Excel вспоминает, что надо перерисовать картинку в Image1.
Как с этим бороться - не знаю. Если честно, вообще не понимаю, какой смысл менять картинку в цикле. Вы таким образом пытаетесь воспроизвести фильм? )

PS: А какое отношение ваш вопрос имеет к теме статьи?

Здравствуйте,
хотела, чтобы картинка менялась в цикле, но получается только в конце цикла картинка отображает последний путь, а во время цикла не меняется

x = 0
While x < 21
Sheet7.Activate
a = Лист2.Cells(2 + x, 2)
Sheet7.Cells(4, 6).Value = a
Sheet7.Cells(4, 10).Value = Лист2.Cells(2 + x, 3)
curfolder = current
p = ActiveWorkbook.Path & "\img\" & a & ".jpg"
Sheet7.Cells(4, 25).Value = p
p2 = ActiveWorkbook.Path & "\img\no.jpg"
If Dir(p, vbDirectory) <> "" Then
Sheet7.Image1.Picture = LoadPicture(p)
Else:
Sheet7.Image1.Picture = LoadPicture(p2)
End If

Sheet7.Cells(5 + x, 1).Value = Dir(p, vbDirectory)
x = x + 1
Application.Wait Now() + TimeValue("00:00:01")
Wend

Проверить, как была вставлена картинка, вряд ли получится.
Вставленная макросом, и добавленная вручную, картинки могут ничем не отличаться...

Проверить файл на существование, если известен полный путь к файлу картинки, очень просто:
if Dir("полный путь к файлу")<>"" then msgbox "Файл существует"

Честно говоря, не понял, как связаны между собой эти 2 вопроса...

Подскажите пожалуйста, можно ли как проверить была ли вставлена картинка методом ActiveSheet.Pictures.Insert или же нет? Возможно проще проверить существует ли файл с фотографией перед ее вставкой? Способ так же мне неизвестный. Просветите пожалуйста...

Спасибо большое администратору за оказанную помощь!!! Но у меня есть еще маленький вопросик:
у меня есть такой код (см. ниже) который из ячейки D3 берет значение пути к картинке (путь к картинке проставляется внешней программой) и вставляет картинку в ячейку E3. При чем вставляет в левый верхний угол.

1) Из этой статьи не совсем разобрался как сделать в моем коде так, чтобы ячейка принимала размер картинки, но чтобы картинки больше 100 на 50 пикселей сжимались до этого размера, и только после этого ячейка могла бы принять размер картинки.

2) Как мне оптимизировать этот код, чтобы макрос определял, какие ячейки в колонке D заполнены (например с 3 по 15 или с 3 по 26) и заполнял картинками колонку E тоже с 3 по 15 или с 3 по 26 соответственно?

With ActiveSheet.Pictures.Insert([D3])
.Top = [E3].Top
.Left = [E3].Left
.Name = [E3]
End With

Я только что направил Вам проект ТЗ о витринах и прилавках.
К ТЗ приложен файл "ИД.Витрина...". В нем динамически меняющиеся раскрывающиеся списки, меняющееся изображение витрины (выполнено в полном соответствии с Вашими рекомендациями), условное форматирование и подсказки "для защиты от дурака". Над размерными линиями надо проставить размеры из таблицы, но ячейки под рисунком не видны (рис.не прозрачный), а текстовое поле НЕ УДАЕТСЯ ПОВЕРХ НЕГО поставить. Почему? - не понимаю... (Ведь, если действовать через меню Вставить/Рисунок, то удается текстовое поле поставить поверх рисунка).

Прим.: В "ИД.Витрина..." управление раскрывающимися списками и условным форматированием осуществляется с скрытого листа.

Насчёт размера файла - проблему легко решить, обработав все ваши картинки специальной программой (которая в пакетном режиме обработает все изображения, уменьшив вес фотографий до 20-80кБ, - достаточно уменьшить размеры картинок или глубину цвета)

Выводить текст на листе Excel в текстбокс - зачем, когда для этого есть ячейки?
Но, если уж так нужен текстбокс, - и его сделать не проблема.
Попробовал - текстовое поле без проблем нарисовалось поверх картинки:

PS: Для подобных вопросов есть форумы по Excel
На этом сайте я обычно помогаю не бесплатно)

Поступил как указано в Ответе #26...
Мой файл при этом "потолстел" в 10 раз (с 506КБ, до 61000КБ).
Так не должно быть.
Прим.: вставляемая в Image2 картинка вести 3900КБ.

Действительно, "всё гениальное просто".
Спасибо!!! Стыдно, но деваться не куда, буду краснеть дальше....
Возникла еще одна проблемка:
Я хотел поверх Image1 (изменяющиеся изображения витрин в зависимости от выбранного в раскрывающ.списке) поместить меняющиеся надписи -габаритные размеры (TextBox), связав их с значениями в ячейках. Однако, не удается поместить эти TextBox над Imege1. Из меню под правой кнопкой мыши не удается выполнить ни "На передний план", ни "На задний план".
Как поступить?

Программирование - это, конечно, занятие творческое, но не до такой степени, чтобы выдумывать произвольные имена встроенным процедурам, и надеяться, что это всё заработает...

При изменении ячеек на листе сработает обработчик Worksheet_Change, а изобретенный вами Worksheet_Ch не сработает ни при каких обстоятельствах.

Замените эти 2 обработчика событий одним:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [AE22:AE23]) Is Nothing Then ОбновлениеКартинкиВитрины
If Not Intersect(Target, [AE26]) Is Nothing Then ОбновлениеКартинкиСтоек
End Sub

Спасибо еще раз! Макрос и процедура работают замечательно!
Но... Захотелось по аналогии пристегнуть сменяющиеся картинки еще к одному раскрывающемуся списку и обломился. Не пойму почему. Подскажите - где ошибка?

Sub ОбновлениеКартинкиВитрины()
On Error Resume Next
Set [Image1].Object.Picture = Nothing
Set [Image1].Object.Picture = LoadPicture([Место_хранения_рисунка_витрины])
End Sub

Sub ОбновлениеКартинкиСтоек()
On Error Resume Next
Set [Image2].Object.Picture = Nothing
Set [Image2].Object.Picture = LoadPicture([Место_хранения_рисунка_стойки])
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [AE22:AE23]) Is Nothing Then ОбновлениеКартинкиВитрины
End Sub

Private Sub Worksheet_Ch(ByVal Target As Range)
If Not Intersect(Target, [AE26:AE26]) Is Nothing Then ОбновлениеКартинкиСтоек
End Sub

Макрос "Обновление картинки стоек" работает, но процедура, привязанная к изменению в ячейке AE26 не запускается. Почему?

СУППЕРРР!
Спасибо громадное!
Подскажите, где можно поучиться VBA для Exel в СПб?

Огромное С П А С И Б О!!!

Да неужели...
смотрите второй способ в этой статье:
http://www.planetaexcel.ru/tip.php?aid=34
вот ещё один способ:
http://www.planetaexcel.ru/tip.php?aid=70

..И тут же получу сообщение " Для условий "Проверка данных" нельзя использовать ссылки на другие листы"

Сделать это просто - присваиваете имя списку фирм, и в "данные\проверка\список..." указываете ссылку на именованный диапазон.

Как сделать ввод фирм в таблицу со списком, если список фирм расположен на другой странице?
(данные\проверка\список...)?

Макрос ОбновлениеКартинки - в стандартный модуль,
обработчик Worksheet_Change - в модуль листа.

Пример в файле: http://excelvba.ru/XL_Files/Sample__04-11-2011__13-22-08.zip

А как сделать, чтобы Процедура "Worksheet_Change" начала работать?
Куда и как её поместить?

Спасибо за оперативный ответ!
Попробую на выходных в домашних условиях.

Николай, всё делается проще, чем вы думаете.

Сначала вставляете в ячейку элемент управления Image:

а потом делаете макрос, изменяющий свойство Picture этого объекта:

Sub ОбновлениеКартинки()
    On Error Resume Next
 
    ' удаляем старую картинку
    Set [Image1].Object.Picture = Nothing
 
    ' добавляем новую
    Set [Image1].Object.Picture = LoadPicture([d5])
End Sub

Осталось вызвать этот макрос при изменении ячейки С3 или C4:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [c3:c4]) Is Nothing Then ОбновлениеКартинки
End Sub

Выше написанное Впечатляет, но для новичка…

На листе 30 раскрывающихся списков (Данные/проверка вводимых значений/список/...).
При изменении значений в ДВУХ списках (ячейка C3 и C4), в соседней ячейке (D5) изменяется путь к картинкам "\\Slim\fileupload\Витрины, прилавки\Рисунки\....jpg".
Надо МЕНЯТЬ картинки при изменении С3 или C4 (старая картинка должна удалятся, новая размещается на её место).
Картики надо вносить в ячейку A20 без изменения размеров ячейки и без изменения размеров картинки.
Макрос должен запускаться тоько при внесении изменений в C3 и/или С4 (при других действиях на листе макрос не должен запускается).

Подмогните, пожалуйста!

А я разве говорил, что копировать надо вручную?
С этим и макрос легко справится...

Вам подойдёт простейший макрос, который копирует первые строки всех файлов в итоговый файл
(в итоговый файл скопируется всё, вместе с картинками)

Скопировать ручками то понятно, я бы тогда у вас не спрашивал. :) Просто есть допустим 20-30 эксельных файлов, внутри которых на первом листе заполнены три столбца в первом ряду, т.е. три ячейки. В первых двух ячейках текст, а в третьей ячейке картинка. Задача в том, чтобы все эти 20-30 файлов (которые называются 1.xls, 2.xls, 3.xls и т.д.) превратить в один файл, у которого будут заполнены соответственно 20-30 первых строк.

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

Можно использовать также функцию getShape:

Function getShape(ByRef cell As Range) As Shape
    Dim sha As Shape
    For Each sha In cell.Worksheet.Shapes
        If sha.TopLeftCell.Address = cell.Address Then
            Set getShape = sha: Exit Function
        End If
    Next sha
End Function
 
Sub КопированиеКартинки()
    getShape([c1]).Copy [c2]
End Sub

Подскажите плиз, как из одного эксельного файла вставить картинку в другой эксельный файл?
Допустим картинка в первом файле находится в (или "над") ячейке C1 и эту картинку нужно вставить в ячейку C2, но уже в другой файл?

Мои Вам благодарности, разобрался со всем.

Ну почему же... макрорекордер записывает и вставку, и удаление картинки:

Sub Макрос2()
'
' Макрос2 Макрос
' Макрос записан 07.10.2011 (Игорь (EducatedFool))
'

    ActiveSheet.Pictures.Insert("D:\Документы\Мои рисунки\123.jpg").Select
    Selection.Delete
End Sub

Но этот макрос можно записать только в Excel 2003 (или более ранних версиях) и Excel 2010.
В Excel 2007 разработчики что-то намудрили с макрорекордером, и он очень много чего не записывает.
Так что проще всего вам будет установить (дополнительно) другую версию Excel - Excel 2007 в этом плане неудачен.

PS: Удалить картинку, зная её название, можно так:

ActiveSheet.Shapes("Рисунок 2").Delete

Макрос - это, конечно, великолепно придумано, однако же, как Вам достоверно известно, если начать запись макроса и, выделив картинку, затем бесповортно удалить ее, то код макроса будет предательски пуст, ни единой строчки в теле функции... Как же быть? Не подскажите функцию по удалению из Книги конкретной картиночки, а?)

Вообще, удаление мне нужно это для того, чтобы динамически обновлять картинку при выборе одной из строк на другом листе (удалил - вставил на то самое мето). Это позволит не вставлять все файлы изображений сразу и соответственно разгрузить саму Книгу, храня изображения отдельно.

Не проще, ибо изображения должны быть на листе для последующей печати.

Да, можно так сделать. (пишете макрос, удаляющий картинки из файла при его закрытии)
Вот только зачем вставлять картинки в файл, если потом их удалять?
Не проще ли просто отобразить картинки на форме, без вставки в ячейки?

Любезнейший, ради всего святого, скажите можно ли сделать так, чтобы добавленная такой замечательнейшей функцией в определенную ячейку картинка, по завершении работы с Книгой автоматически удалялась?

То что дохтер прописал :)

Нижайшее МЕРСИ !!!

Для этого вам понадобится функция вывода диалогового окна выбора файла.

Ваш код будет выглядеть так:

Sub ВставкаИзображенияВЯчейку()
 
    ' запрашиваем полный путь к файлу изображения
    ПутьКФайлуСКартинками = GetFilePath("Выберите изображение", , "Изображения", "*.*")
 
    ' вставляем изображение в активную ячейку (картинка вписывается в ячейку)
   ВставитьКартинку ActiveCell, ПутьКФайлуСКартинками, True, True, True
 
End Sub
 
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath As String = "c:\", _
                     Optional ByVal FilterDescription As String = "Книги Excel", _
                     Optional ByVal FilterExtention As String = "*.xls*") As String
    ' функция выводит диалоговое окно выбора файла с заголовком Title,
   ' начиная обзор диска с папки InitialPath
   ' возвращает полный путь к выбранному файлу, или пустую строку в случае отказа от выбора
   ' для фильтра можно указать описание и расширение выбираемых файлов
   On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
    End With
End Function

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

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

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

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