Vba excel рисунок в ячейке

Требуется макросом поместить изображение (картинку) на лист 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

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.