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

Комментарии

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

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

Подскажите плиз, как из одного эксельного файла вставить картинку в другой эксельный файл?
Допустим картинка в первом файле находится в (или "над") ячейке 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

Прошу прощения за мой *французский*...
Но, если не известен точный путь файла картинки, и нужно найти его вручную.
Что нужно вписать вместо строки

ПутьКФайлуСКартинками = "D:\BMP\AboutForm.jpg"

чтоб выскакивало окошко для поиска (аналог кнопки *вставить картинку* на панели инструментов)?

Или может быть как-то можно закрепить эту кнопку на листе?

Здравствуйте, Игорь.

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

Спасибо за Ваши работы, парочку из них уже использовал в работе, значительно упростив код.

С уважением, Виталий

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

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

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

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