Insert pictures для 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

Хитрости »

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


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

Сама по себе задача вставки картинки на листе не сложная и ответ лежит на поверхности: это доступно прямо из меню: Вставка(Insert) -группа Иллюстрации(Illustrations)Рисунок(Picture):
Вставка Рисунка в Excel
Кодом 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) —InsertModule) и вставить в него приведенный выше код. Чтобы картинка вставилась в ячейку, надо записать имя картинки в ячейку 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
ссылки
статистика

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

#1

14.01.2014 15:43:58

Добрый день Великие!
Столкнулся с проблемой: Данные в файле формируются посредством ВПР из разных баз. Единственное с чем не получается — это изображение.
Действие происходит следующим образом: в ячейку «K1» вписывается ФИО человека, по этому ФИО данные собираются с разных мест. Есть папка с изображениями «C:System32PictureAvatar», где названия фото соответствуют ФИО людей.
Мне необходимо чтобы фото тоже подтягивалось из папки в ячейку «I5» (или диапазон ячеек) — оптимально по ширине или высоте ячейки (выравнивание по левому краю).
Перерыв интернет нашел только такую формулу, но в ней разобраться полностью не могу:

Код
Sub Vstavka_Kartinok() 
Sheets("Лист1").Select 
x = 1 
Range("A1").Select 
While Sheets("Лист1").Cells(x, 2).Text <> "" 
x = x + 1 
Wend 
x = x - 1 
For i = 2 To x 
kartinka = Sheets("Лист1").Cells(i, 2).Value 
Range("E" & CStr(i)).Select 
Dim SR As ShapeRange 

ActiveSheet.Pictures.Insert("C:1" & CStr(kartinka) & ".jpg").Select 
'Set SR = Selection.ShapeRange 

[B]Selection.ShapeRange.Left = 200 
Selection.ShapeRange.Top = 100 * (i - 2)[/B] 

Selection.ShapeRange.LockAspectRatio = msoFalse 
Selection.ShapeRange.Height = 152.2 
Selection.ShapeRange.Width = 183.75 
Selection.ShapeRange.Rotation = 0# 
Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft 
Next i 
MsgBox ("Изображение загружено") 
End Sub 

Sub InsertShapeNode() 
ActiveSheet.Shapes(1).Select 
With Selection.ShapeRange 
If .Type = msoFreeform Then 
.Nodes.Insert _ 
Index:=3, SegmentType:=msoSegmentCurve, _ 
EditingType:=msoEditingSymmetric, X1:=35, Y1:=100 
.Fill.ForeColor.RGB = RGB(0, 0, 200) 
.Fill.Visible = msoTrue 
Else 
MsgBox "This shape is not a Freeform object." 
End If 
End With 
End Sub

Помогите гуманитарию, если сталкивались с такой проблемой!

 

Антон

Пользователь

Сообщений: 617
Регистрация: 01.01.1970

#2

14.01.2014 21:03:53

Запишите обыкновенный макрос вставки картинки с диска макрорекодером. Затем измените путь и все.

Код
 ActiveSheet.Pictures.Insert("C:UsersServerPictures1.png").Select
 

Изменено: Антон14.01.2014 22:03:30

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

Попробуйте прием описанный

тут.

По-моему Вам должно подойти.

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

#4

03.03.2014 15:34:04

Цитата
Антон пишет: Запишите обыкновенный макрос вставки картинки с диска макрорекодером. Затем измените путь и все.

Микрорекордером не получается правильно задать условное название переменной, а именно: Photobaza» & a1 & «.jpg»  ;)

Цитата
ts-79 пишет: Попробуйте прием описанный тут. По-моему Вам должно подойти.

Такой вариант смотрел, не то что нужно (количество более 500 шт.).
на данный момент пришел к новому макросу, но не работает, пишет что требуется объект. В силу своей неграмотности, что-то не то написал. Может подскажите:

Код
Sub SelectionPhoto()
If Target.Address = "$AF$1" Then
    ActiveSheet.Pictures.Insert("C:Users\Photobaza" & Target.Value).Select
    Selection.Left = Columns("Z".Left
    Selection.Top = Rows(5).Top
End If
End Sub
 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

#5

04.03.2014 07:35:43

Цитата
Cipariz пишет:
Такой вариант смотрел, не то что нужно (количество более 500 шт.).

Согласен. Не очень удобно и трудоёмко. У меня стояла аналогичная задача, но только список в 2 раза меньше Вашего. Пару дней пришлось потратить на сканирование и вставку фото.
Эта тема меня тоже очень сильно интересует, поскольку часто приходится обновлять фото. Поэтому подписался сразу на эту тему когда увидел.
Но помочь с макросом, к сожалению, вне пределов моих скудных познаний.
Отпишитесь пожалуйста если найдете решение.

 

Игорь

Пользователь

Сообщений: 3631
Регистрация: 23.12.2012

Может, проще нажать одну кнопку, чтобы всё само вставилось?

http://excelvba.ru/programmes/PastePictures

Изменено: Игорь04.03.2014 08:28:39

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

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

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

#8

04.03.2014 09:56:42

Вот так работает, но при условии что название фото полностью совпадает с ФИО в А1 (без лишних пробелов) и имеет расширение *.jpg. Кроме того, вставляет реальный размер фото. Как подогнать под размер ячейки пока не знаю. Экспериментирую дальше.

Код
Sub SelectionPhoto()
Dim r As String
r = Sheets("ПКС").Cells(1, 1).Value
Sheets("ПКС").Pictures.Insert("C:Usersok5DesktopФото сотрудников" & r & ".jpg").Select 
Selection.Left = Columns("Z").Left 
Selection.Top = Rows(5).Top 
End Sub 

Изменено: ts-7904.03.2014 10:17:58

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

Работает, с размерами тоже экспериментирую)))

 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

Может использовать пользовательскую форму и в ней
выбирать ФИО из списка и подтягивать данные и фото.

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

#11

04.03.2014 13:48:16

Код
Sub SelectionPhoto() 
  Dim r As String 
  r = Sheets("Êàðòà" ) .Cells(1, 32).Value 
  Sheets("Êàðòà" ) .Pictures.Insert("C:UsersPhotoBaza" & r & ".jpg" ) .Select 
  Selection.Left = Columns("Z" ) .Left 
  Selection.Top = Rows(5).Top 
  With Selection 
    .Top = 55 
    .Left = 480 
    .Width = 50 
    .Height = 160 
  End With 
End Sub

Виноват, справлюсь)

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

#12

04.03.2014 13:49:46

Тогда эти строки уже лишние

Код
Selection.Left = Columns("Z").Left 
Selection.Top = Rows(5).Top 
 

Вариант если фото можно жестко привязать к определенному месту, предназначенному для фото.

 

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

Посмотрите пример из книги Билла Джелена,
файлы с фото д.б. в том же каталоге, что и
рабочая книга с макросом

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

Спасибо за совет и пример.
Наверное это все можно реализовать и на листе.
Вставить соответствующий элемент ActiveX и прописать соответствующий код. Да и путь к каталогу с фото также думаю можно прописать в другое место.
Надо поэкспериментировать. На досуге попробую. Сейчас пока другие задачи.

Изменено: ts-7904.03.2014 14:13:34

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

#15

04.03.2014 16:03:04

А ссылкой у меня тоже проблема появилась, изначально документы выложил в гугл диск, и дал доступ другим, а фото на других компах не вставляет, так как в ссылке присутствует разное название компьютеров, например: «C:Users1 или 2 или 3Google ДискPhotoBaza» & r & «.jpg»/

Вариант:

Цитата
Kuzmich пишет: ФормаВводаПользовательскихДанных.rar

не совсем удобен когда файл размещен в папке с большим количесвом фотографий. Хотя они и находяться в паралелльных папках: Google ДискPhotoBaza и Google ДискBaza.

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

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

Вариант предложенный Kuzmich-ем, адаптированный под Image на листе долго подгружает фото (несколько секунд), и имеется та же проблема с подгоном размера фото под размеры Image. Либо сразу необходимо складировать фото с определенными размерами.

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

#17

04.03.2014 16:10:55

Цитата
ts-79 пишет: Вариант с SelectionPhoto() в этом виде приведет к катастрофическому увеличению размера файла,…

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

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

#18

04.03.2014 16:21:08

Цитата
Cipariz пишет:
первый чистит фотки,

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

 

Cipariz

Пользователь

Сообщений: 8
Регистрация: 14.01.2014

#19

04.03.2014 16:25:08

Код
Sub StartMain()
 Call DeleteButton
 Call SelectionPhoto
End Sub

Sub DeleteButton()
  Dim figa As Shape
  For Each figa In ActiveSheet.Shapes
  If Not Intersect(Range(figa.BottomRightCell.Address), Range("Z5:AE16")) Is Nothing Then   'диапазон ячеек где находиться картинка
  figa.Delete
  End If
  Next
End Sub

Sub SelectionPhoto()
 Dim r As String
 r = Sheets("Карта" ;) .Cells(1, 32).Value
 Sheets("Карта" ;) .Pictures.Insert("C:UsersGoogle ДискBazaPhotobaza" & r & ".jpg" ;) .Select
 Selection.Left = Columns("Z" ;) .Left
 Selection.Top = Rows(5).Top
 With Selection
 .Top = 55
 .Left = 480
 .Width = 50
 .Height = 160
 End With
End Sub

Не вопрос

Изменено: Cipariz04.03.2014 16:29:10

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

#20

04.03.2014 16:32:16

Цитата
Cipariz пишет: Application.Calculate

Но Application.Calculate просто пересчитывает, но не удаляет предыдущие фото.

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

#21

05.03.2014 18:05:29

По совету Kuzmichа:

На лист в нужное месть добавляем элемент ActiveX Image (изображение) необходимого размера.
В исходный текст листа прописываем код:

Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.text = "" Then Exit Sub
    If Not Intersect(Target, Cells(1, 1)) Is Nothing Then
       iName = Target
       Image1.Picture = LoadPicture(ThisWorkbook.Path & "фото сотрудников" & iName & ".jpg" 
 
      End If 
End Sub

Фото будет менятся при изменении/выборе ФИО в ячейке А1.
Папка с фото должна находится в той же директории что и сам файл Ексель

Если папку с фото необходимо расположить в другом месте то строку в коде необходимо заменить на

Код
 Image1.Picture = LoadPicture("C:Usersok5Desktopфото сотрудников" & iName & ".jpg" 

где: C:Usersok5Desktopфото сотрудников — путь к папке с фото.

Подгон фото под размер элемента Image (изображение), осуществляется в свойствах этого элемента.
PictureSizeMode необходимо выбрать 1- fmPictureSizeModeStretch (по умолчанию 0- fmPictureSizeModeClip).
Это в Ексель 2010. В других не знаю как. Но нужно искать свойство Stretch и выставлять True.

Вот такой вариант получился у меня.

 

Игорь

Пользователь

Сообщений: 3631
Регистрация: 23.12.2012

Обратите внимание:метод .Pictures.Insert в Excel 2010 вставляет не сами картинки, а ссылки на картинки.
Если вы потом этот файл с картинками кому-нибудь вышлете по почте, — получателю картинки видны не будут.

Лучше использовать другой способ вставки:

http://excelvba.ru/code/PastePictures#comment-3126

 

UnDrew

Пользователь

Сообщений: 81
Регистрация: 24.12.2012

Игорь, не намекнете как у вас в надстройке вставляется картинка ЛЮБОГО формата, т.е. неважно jpg, bmp, png и т.д.?
С уважением, Андрей.

 

ts-79

Пользователь

Сообщений: 246
Регистрация: 15.02.2013

Наверное лучше и быстрее будет спросить об этом на сайте автора, по мейлу, скайпу или аське.

Изменено: ts-7911.04.2014 17:36:59

 

Антон

Пользователь

Сообщений: 617
Регистрация: 01.01.1970

#25

13.04.2014 10:00:16

Цитата
UnDrew пишет:вставляется картинка ЛЮБОГО формата, т.е. неважно jpg, bmp, png и т.д.?
Код
 PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , False)

добавьте расширения и все

Содержание

  1. How to Insert, Move & Delete Pictures with VBA
  2. Adapting the code to your needs
  3. Insert an image into a worksheet
  4. Image names
  5. Get image properties
  6. Delete an image
  7. Make images invisible
  8. Loop through all images on a worksheet
  9. Delete an image
  10. Confirm if the selected object is a picture
  11. Linked pictures
  12. Image placement and locking options
  13. Rotate images
  14. Set image position to the center of a cell
  15. Flipping an image horizontally or vertically
  16. Resize an image
  17. Cropping
  18. Changing Z-Order
  19. Set the background image
  20. Save picture from Excel
  21. Conclusion
  22. Вставить картинку в лист — по списку или выбору из ячейки

How to Insert, Move & Delete Pictures with VBA

While it is not often that we have to control pictures or images within Excel, based on the number of Google searches for this topic, it’s clearly something people want to know more about. This post serves as a reference to cover most of the scenarios we’re likely to encounter to copy, insert, move, delete and control pictures.

This code can be used in conjunction with my post about using a user defined function to insert and change pictures based on a cell value, which can be found here: https://exceloffthegrid.com/automatically-change-picture/

Download the example file

I recommend you download the example file for this post. Then you’ll be able to work along with examples and see the solution in action, plus the file will be useful for future reference.

Download the file: 0042 VBA copy insert, move, delete pictures.zip

Adapting the code to your needs

It is unlikely that any of the codes will meet your exact requirements. Every code snippet uses variables to hold either the image, the worksheet, a range or an object. By changing those variables, the code can easily be changed and combined with other code snippets to meet your specific requirements.

Insert an image into a worksheet

The following code will insert an image into the active cell of the active worksheet, keeping the original image’s size.

Depending on our needs, it may be better to create an image straight into an object variable. Then we can refer to the image by using the variable and do not need to know the name of the image. The following code is an example of this technique.

Image names

The code below will display the name of the last inserted image.

The message box is to illustrate that the code works. Once we have captured the shape as an object in the real world, we would perform other actions on the shape.

The code below renames an existing image.

Get image properties

The following code demonstrates how to retrieve common image properties

Delete an image

The following code will delete an image called Picture 1 from the active worksheet.

Make images invisible

Images can be made invisible. They still exist and are part of the workbook, but they are not visible to the user.

Loop through all images on a worksheet

The following code will loop through all the images on the active sheet.

Delete an image

The code below will delete a specific named picture.

Confirm if the selected object is a picture

The code below will check if a specific object is a Picture.

Linked pictures

Images can be linked to cells or named ranges. This makes the image dynamic; when the contents of the cells change, so does the picture.

Image placement and locking options

Image behavior can be controlled using the placement option.

Rotate images

The following code rotates the image by a specific amount

The following code rotates the image to a specific amount.

Set image position to the center of a cell

An image is positioned based on the top and left of that image. The following code will set the position so that it appears centered within a specific cell.

Flipping an image horizontally or vertically

Flip the image horizontally:

Flip the image vertically:

Resize an image

The code below locks the aspect ratio; therefore, resizing the width or height will maintain the image’s proportions.

When setting the aspect ratio to msoFalse, the height and width operate independently.

The following code positions an image and stretches it to perfectly cover a specified range.

Cropping

The code below crops an image based on the distance from the top, left, bottom or right.

Changing Z-Order

The image can be moved forward or backward within the stack of objects (known as the Z-Order).

The Z-Order position cannot be set directly. First, send the image to the back, then move the image forward with a loop. Continue looping until the image reaches the correct Z-Order Position.

Set the background image

The background image appears behind the cells in the spreadsheet.

Save picture from Excel

If we have a picture in an Excel workbook, there is no straightforward way to save it to disk as a picture. A common workaround is to set the picture as the background of a chart area, then export the chart as an image.

Conclusion

In this post we have provided over 25 examples to demonstrate how to insert, delete, move and control pictures with VBA. Checkout the other posts on this site which use these techniques:

About the author

Hey, I’m Mark, and I run Excel Off The Grid.

My parents tell me that at the age of 7 I declared I was going to become a qualified accountant. I was either psychic or had no imagination, as that is exactly what happened. However, it wasn’t until I was 35 that my journey really began.

In 2015, I started a new job, for which I was regularly working after 10pm. As a result, I rarely saw my children during the week. So, I started searching for the secrets to automating Excel. I discovered that by building a small number of simple tools, I could combine them together in different ways to automate nearly all my regular tasks. This meant I could work less hours (and I got pay raises!). Today, I teach these techniques to other professionals in our training program so they too can spend less time at work (and more time with their children and doing the things they love).

Do you need help adapting this post to your needs?

I’m guessing the examples in this post don’t exactly match your situation. We all use Excel differently, so it’s impossible to write a post that will meet everybody’s needs. By taking the time to understand the techniques and principles in this post (and elsewhere on this site), you should be able to adapt it to your needs.

But, if you’re still struggling you should:

  1. Read other blogs, or watch YouTube videos on the same topic. You will benefit much more by discovering your own solutions.
  2. Ask the ‘Excel Ninja’ in your office. It’s amazing what things other people know.
  3. Ask a question in a forum like Mr Excel, or the Microsoft Answers Community. Remember, the people on these forums are generally giving their time for free. So take care to craft your question, make sure it’s clear and concise. List all the things you’ve tried, and provide screenshots, code segments and example workbooks.
  4. Use Excel Rescue, who are my consultancy partner. They help by providing solutions to smaller Excel problems.

What next?
Don’t go yet, there is plenty more to learn on Excel Off The Grid. Check out the latest posts:

Источник

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

Сама по себе задача вставки картинки на листе не сложная и ответ лежит на поверхности: это доступно прямо из меню: Вставка (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 ) —InsertModule) и вставить в него приведенный выше код. Чтобы картинка вставилась в ячейку, надо записать имя картинки в ячейку 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 330 скачиваний)

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

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

‘————————————————————————————— ‘ 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 «» 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 330 скачиваний)

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

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

Источник

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.

Insert Picture Using VBA Code

Insert Picture 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(&lt;path of your picture in local drive&gt;)
        .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.

Warning!
This method, simply links the image in to your Excel Sheet. It means, after inserting a picture, using this method, if you send it to another computer, picture will not be displayed and an Error message be displayed.

Therefore, this method is good only when you are going to use this excel sheet always in your own computer.

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.

For your practice I have created an Excel workbook which you can download and play around.

VBA Code Insert Picture  - Sample Workbook

VBA Code Insert Picture – Sample Workbook

Понравилась статья? Поделить с друзьями:
  • Insert pictures into word
  • Insert pictures in excel cell
  • Insert picture to excel cell
  • Insert picture into picture word
  • Insert picture in excel vba