Как в excel vba изображение

Dear Friends,
In this article, I am going to teach you a simple VBA code, which help you in inserting a picture in Excel Sheet. I will also discuss about difference between Inserting a picture in Excel and Embedding a picture in Excel Sheet using Excel VBA.
It is based on request from one of LEM reader who wants to know, How to insert a picture in excel sheet using VBA code It is a very simple one liner code to insert a picture in Excel using vba code.

Basically, there are two methods to insert a picture in Excel Sheet
Method 1. ActiveSheet.Pictures.Insert
Method 2. ActiveSheet.Shapes.AddPicture

VBA Code for Inserting Picture in Excel Sheet [Method 1]

Using .Pictures.Insert() method, you can insert a picture in Active sheet. Let see the Syntax of this method:

Syntax of .Pictures.Insert Method

[highlight color=”yellow”]ActiveSheet.Pictures.Insert(‘Picture URL’)[/highlight]

This function requires only one parameter – Full path of the picture to be inserted in Excel Sheet. This is a mandatory parameter here.

For Example:

ActiveSheet.Pictures.Insert(“C:….myPic.jpg”)

Above statement will simply insert myPic.jpg picture in Active sheet in its original Size.
If you want to resize and locate the picture according to you, then use the following statement to resize the image and place it where ever you want in the excel sheet.

1. VBA Code to re-size (height and width) the inserted picture

Below code will set the height and width of the selected picture in worksheet which is inserted using VBA code:

    With ActiveSheet.Pictures.Insert("Picture full path")
        .Left = 110
        .Top = 220
        .Width = 123
        .Height = 134
    End With

Explanation and issues with above Code

Left and Top will be set without any issue.
Later, Width of the image will be set to 123 as specified – Height of the image will be automatically set to a respective height to the width – because AspectRatio of the image is by default set to True
Similarly when control goes to the next statement then it will reset the height to 134 and since, aspect ratio is false, width will be adjusted to new respective value.

Challenge here is that you can NOT set AspectRatio flag of the picture while inserting it. (by above statement)

Therefore, be careful while resizing the picture while inserting it by using the above code

So what is the solution?

Here is the solution…
1. first add the picture in its own size.
2. Store the name of this image (uniquely generated one) in a variable. So that you can refer this picture uniquely later on
3. Using this variable, select that Shape and set the aspect ratio to false
4. Then set the height and width of the picture.

Here is the code now…

    Dim nameOfPicture as String
    With ActiveSheet.Pictures.Insert("Picture file full path")
        .Left = ActiveSheet.Range("photograph").Left + 2
        .Top = ActiveSheet.Range("photograph").Top + 2
        nameOfPicture= .Name
    End With
    ActiveSheet.Pictures(profile).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Width = 123
        .Height = 134
    End With

2. VBA Code to set the location of the inserted Picture

Here you can either set fixed Left and Top value where you want to place your picture. In this case no matter what is the height and width of the cell in the worksheet, your picture will be always placed at a specific location. But suppose if you want – your picture should always be placed at a specific row and column then you can set the left and top values as follows:

    With ActiveSheet.Pictures.Insert(<path of your picture in local drive>)
        .Left = ActiveSheet.Range("A1").Left 
        .Top = ActiveSheet.Range("A1").Top 
        .Placement = 1
    End With

Now your selected picture will always be placed where Column A1 starts from left and Row 1 starts from top. It means even if you change height or width of the Range A1, your picture is always going to be in Range A1 only.

VBA Code for Embedding Picture in Excel Sheet [Method 2]

Using .Shapes.AddPicture() method, you can insert a picture in Active sheet. This method overcome the challenges of above method. This allows user to Embed the picture with the Excel Workbook itself. It means, even if you share the workbook to other computer… this picture will go with the document and you will be able to see it in other computer as well.

Syntax of .Shapes.AddPicture Method

[highlight color=”yellow”].Shapes.AddPicture( Filename , LinkToFile , SaveWithDocument , Left , Top , Width , Height )[/highlight]

Where:

Filename : (Mandatory) As the names suggests, this is the complete file path of the picture you want to embed to your Excel Sheet
LinkToFile : (Mandatory) MsoTriState- True or False – To set whether you want to create a link to the file?
SaveWithDocument : (Mandatory) MsoTriState – True or False – This is the flag which needs to be set to TRUE to embed the picture with Excel Sheet.
Left : (Mandatory)The position of the upper-left corner of the picture with respect to the upper-left corner of the document.
Top : (Mandatory) The position (in points) of the upper-left corner of the picture with respect to the top of the document.
Width : (Mandatory) The width of the picture you want to set. To keep the picture in its original width provide -1
Height : (Mandatory) The Height of the picture you want to set. To keep the picture in its original Height provide -1

Example:

Following VBA code will Embed this picture with the Excel file and it will display in any computer you sent it.

ActiveSheet.Shapes.AddPicture _
Filename:="full path of your file with extension", _
linktofile:=msoFalse, savewithdocument:=msoCTrue, _
Left:=50, Top:=50, Width:=250, Height:=250

Info !
Therefore .Shapes.AddPicture Method can insert a picture with and without links just simply by passing some flags.

Хитрости »

6 Февраль 2020              22744 просмотров

Вставить картинку в лист — по списку или выбору из ячейки

Сама по себе задача вставки картинки на листе не сложная и ответ лежит на поверхности: это доступно прямо из меню: Вставка(Insert) -группа Иллюстрации(Illustrations) —Рисунок(Picture):

Кодом VBA вставить тоже не сложно, даже макрорекордер записывает это действие:

Sub InsertPicture()
    ActiveSheet.Pictures.Insert("G:ДокументыИзображенияExcel_vba_ru.png"). _
        Select
End Sub

Но что делать, если вставить надо картинку из заранее известной папки, но с изменяющимся именем? А если при этом еще надо не просто вставить — а подогнать размер картинки под размер ячейки? Например, в ячейке А2 название товара(соответствует названию картинки), а в В2 должно быть изображение. Здесь уже посложнее. Но тоже вполне реализуемо при помощи VBA

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: вставка в ячейку картинки с подгонкой под размеры ячейки
'---------------------------------------------------------------------------------------
Sub InsertPicToCell()
    'путь к папке с картинками
    Const sPicsPath As String = "G:ДокументыИзображения"
    Dim sPicName As String, sPFName As String, sSpName As String
    Dim oShp As Shape
    Dim zoom As Double
 
    'в этой ячейке выпадающий список с именами картинок
    sPicName = Range("A2").Value
    'если имя картинки не задано
    If sPicName = "" Then
        Exit Sub
    End If
    'проверяем наличие картинки в папке
    sPFName = sPicsPath & sPicName
    If Dir(sPFName, 16) = "" Then
        Exit Sub
    End If
    'в эту ячейку вставляем картинку
    With Range("B2")
        On Error Resume Next
        'задаем картинке уникальный адрес,
        'привязанный к адресу ячейки
        sSpName = "_" & .Address(0, 0) & "_autopaste"
        'если картинка уже есть - удаляем её
        Set oShp = ActiveSheet.Shapes(sSpName)
        If Not oShp Is Nothing Then
            oShp.Delete
        End If
        'вставляем выбранную картинку
        Set oShp = ActiveSheet.Shapes.AddPicture(sPFName, False, True, .Left + 1, .Top + 1, -1, -1)
        'определяем размеры картинки в зависимости от размера ячейки
        zoom = Application.Min(.Width / oShp.Width, .Height / oShp.Height)
        oShp.Height = oShp.Height * zoom - 2
        'переименовываем вставленную картинку(чтобы потом можно было заменить)
        oShp.Name = sSpName
    End With
End Sub

Чтобы использовать код необходимо создать в книге стандартный модуль(переходим в редактор VBA(Alt+F11) —Insert —Module) и вставить в него приведенный выше код. Чтобы картинка вставилась в ячейку, надо записать имя картинки в ячейку A2, нажать сочетание клавиш Alt+F8 и выбрать макрос InsertPicToCell. Не очень удобно, правда?
Значит теперь попробуем сделать так, чтобы при каждом изменении в А2 картинка менялась сама, без необходимости запускать каждый раз код вручную. Для этого придется использовать возможность Excel отслеживать такие события, как изменения ячейки(чтобы лучше понять где это лучше сразу прочитать статью Что такое модуль? Какие бывают модули? и особое внимание уделить описанию про модули листов). Теперь чуть переделываем код:

Private Sub Worksheet_Change(ByVal Target As Range)
'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: вставка в ячейку картинки с подгонкой под размеры ячейки
'---------------------------------------------------------------------------------------
    'путь к папке с картинками
    Const sPicsPath As String = "G:ДокументыИзображения"
    Dim sPicName As String, sPFName As String, sSpName As String
    Dim oShp As Shape
    Dim zoom As Double
    'т.к. список с именами картинок у нас в ячейке А2,
    'то определяем, что значение изменилось именно в ней
    '   если в ячейке А2 имена картинок, а список товара в другой ячейке
    '   то надо заменить А2 на ту, которая изменяется списком или руками
    If Intersect(Target, Range("A2")) Is Nothing Then
        'изменения не в А2 - ничего не делаем, завершаем код
        Exit Sub
    End If
    'в этой ячейке выпадающий список с именами картинок
    sPicName = Range("A2").Value
    'если имя картинки не задано
    If sPicName = "" Then
        Exit Sub
    End If
    'проверяем наличие картинки в папке
    sPFName = sPicsPath & sPicName
    If Dir(sPFName, 16) = "" Then
        Exit Sub
    End If
    'в эту ячейку вставляем картинку
    With Range("B2")
        On Error Resume Next
        'задаем картинке уникальный адрес,
        'привязанный к адресу ячейки
        sSpName = "_" & .Address(0, 0) & "_autopaste"
        'если картинка уже есть - удаляем её
        Set oShp = ActiveSheet.Shapes(sSpName)
        If Not oShp Is Nothing Then
            oShp.Delete
        End If
        'вставляем выбранную картинку
        Set oShp = ActiveSheet.Shapes.AddPicture(sPFName, False, True, .Left + 1, .Top + 1, -1, -1)
        'определяем размеры картинки в зависимости от размера ячейки
        zoom = Application.Min(.Width / oShp.Width, .Height / oShp.Height)
        oShp.Height = oShp.Height * zoom - 2
        'переименовываем вставленную картинку(чтобы потом можно было заменить)
        oShp.Name = sSpName
    End With
End Sub

Теперь переходим на лист, где в А2 будет изменяться название картинки -правая кнопка мыши на этом листе —Посмотреть код(View Code). Вставляем код выше. Все, теперь при любом изменении в А2 картинка будет изменяться(если указанный файл будет найден в нужной папке).
Если картинки расположены не в «G:ДокументыИзображения», а в той же папке, что и сама книга с кодом, достаточно эту строку
Const sPicsPath As String = «G:ДокументыИзображения»
заменить такими
Dim sPicsPath As String
sPicsPath = ThisWorkbook.Path & «»
тогда папка с книгой будет определяться автоматически.
Но я понимаю, что куда правильнее в ячейке А2 при помощи выпадающего списка выбирать наименование товара, а в В2 при помощи функции ВПР(VLOOKUP) подтягивать из справочника название картинки и уже по этому названию вставлять картинку. Но подстроить код под это уже не сложно. Приводить его здесь не буду, т.к. можно будет запутаться с описанием списка, функций, где и что. Тем более что сам код практически не отличается. К тому же именно в этой реализации код есть в приложенном к статье файле.
Скачать файл:

  Вставить картинку в ячейку (366,9 KiB, 2 392 скачиваний)

И еще часто встречающаяся задача по вставке картинок — это вставка картинок массово. Т.е. вставить картинки на основании значений, записанных в столбце. В данном случае это столбец В. А вставлять картинки будем в столбец С, подгоняя размеры картинок под размер каждой ячейки и проверяя, не вставляли ли мы эту картинку туда ранее

Впрочем, основная часть кода была приведена выше — здесь мы лишь добавим цикл по ячейкам. Так же в этом коде мы используем диалог выбора папки, в котором просматривать картинки:

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: вставка в ячейку картинки с подгонкой под размеры ячейки
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub InsertPictureByVal()
    Dim sPicsPath As String
    Dim sPicName As String, sPFName As String, sSpName As String
    Dim llastr As Long, lr As Long
    Dim oShp As Shape
    Dim zoom As Double
 
    'выбираем путь к папке с картинками
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку с картинками"       'заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear                              'очищаем установленные ранее типы файлов
        .InitialFileName = ThisWorkbook.Path        'назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons  'вид диалогового окна
        If .Show = 0 Then Exit Sub               'показываем диалог
        sPicsPath = .SelectedItems(1) 'считываем путь к папке
    End With
    '   если путь надо указать статичный - вместо диалога прописываем одну строку
    '   sPicsPath = "C:images"
 
 
    'проверяем, есть ли слеш после пути к папке
    'если нет - добавляем, иначе путь к картинке будет неверный
    If Right(sPicsPath, 1) <> Application.PathSeparator Then
        sPicsPath = sPicsPath & Application.PathSeparator
    End If
    'определяем последнюю ячейку по столбцу с именами картинок
    llastr = Cells(Rows.Count, 2).End(xlUp).Row
    'если кроме шапки в столбце с именами картинок ничего нет
    If llastr < 2 Then
        Exit Sub
    End If
    'цикл по столбцу с именами картинок
    For lr = 2 To llastr
        sPicName = Cells(lr, 2).Value
        'проверяем наличие картинки в папке
        sPFName = sPicsPath & sPicName
        If Dir(sPFName, 16) <> "" And sPicName <> "" Then
            'в эту ячейку вставляем картинку
            With Cells(lr, 3)
 
                'задаем картинке уникальный адрес,
                'привязанный к адресу ячейки
                sSpName = "_" & .Address(0, 0) & "_autopaste"
                'если картинка уже есть - удаляем её
                Set oShp = Nothing
                On Error Resume Next
                Set oShp = ActiveSheet.Shapes(sSpName)
                If Not oShp Is Nothing Then
                    oShp.Delete
                End If
                On Error GoTo 0
                'вставляем выбранную картинку
                Set oShp = ActiveSheet.Shapes.AddPicture(sPFName, False, True, .Left + 1, .Top + 1, -1, -1)
                'определяем размеры картинки в зависимости от размера ячейки
                zoom = Application.Min(.Width / oShp.Width, .Height / oShp.Height)
                oShp.Height = oShp.Height * zoom - 2
                'переименовываем вставленную картинку(чтобы потом можно было заменить)
                oShp.Name = sSpName
            End With
        End If
    Next
End Sub

Прикладываю пример в формате ZIP-архива, т.к. вместе с самим файлом с кодом я приложил папку images, которая содержит картинки, используемые для вставки в файле. Папка images и сам файл с кодом должны быть распакованы в одну папку.
Скачать файл:

  Вставить картинку в ячейку (366,9 KiB, 2 392 скачиваний)

Обратная задача — сохранение картинок из листа — уже разбиралась мной в этой статье: Как сохранить картинки из листа Excel в картинки JPG

Так же см.:
Как сохранить картинки из листа Excel в картинки JPG
При вставке из VBA картинки на лист ошибка «Метод paste из класса worksheet завершен неверно»
Как скопировать картинку из примечания?
Копирование картинки из примечания

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика