Как вставить картинки в 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

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

'---------------------------------------------------------------------------------------
' 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

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

'---------------------------------------------------------------------------------------
' 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

Мы можем вставить несколько изображений сразу с помощью функции (Вставить) Изображение в Excel, а затем изменить их размер одновременно. Пожалуйста, сделайте следующее:

1. На листе щелкните Вставить > Картина.

2. В диалоговом окне «Вставить изображение» откройте папку, содержащую изображения, которые вы будете вставлять, выберите несколько изображений, которые вам нужны, и нажмите кнопку Вставить кнопка. Смотрите скриншот:
Внимание: Держа Ctrl клавишу, вы можете выбрать несколько несмежных изображений, щелкая их по одному; держа Shift клавишу, вы можете выбрать несколько соседних изображений, щелкнув первое изображение и последнее.

Теперь изображения вставляются навалом и складываются на листе.

3. Выделите эти изображения и измените их размер сразу, введя новый номер в оба Ширина и Высота коробки в Размер группы на Формат таб. Смотрите скриншот:

Теперь все вставленные картинки изменяются до одинакового размера одновременно сразу.

4. В настоящее время вам необходимо вручную переместить каждую картинку отдельно на подходящее место.

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

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

Наблюдения и советы этой статьи мы подготовили на основании опыта команды Сопоставить Импорт изображений особенность Kutools for Excel, — это фантастический инструмент, который может пакетно импортировать и вставлять несколько изображений на основе содержимого ячейки, а также легко изменять размер импортированных изображений в соответствии с размером ячейки или до указанного размера.

Kutools for Excel — Включает более 300 удобных инструментов для Excel. Полнофункциональная бесплатная пробная версия 30-день, кредитная карта не требуется! Get It Now

Чтобы избежать перемещения изображений друг за другом, в этом методе представлен еще один трюк для вставки нескольких изображений с помощью OneNote. Пожалуйста, сделайте следующее:

1. Запустите OneNote и создайте новую страницу. А затем нажмите Вставить > Картина.

2. В диалоговом окне «Вставить изображение» откройте папку, содержащую изображения, которые вы будете вставлять, выберите несколько изображений, которые вам нужны, и нажмите кнопку Вставить кнопка. Смотрите скриншот:
Внимание: Держа Ctrl клавишу, вы можете выбрать несколько несмежных изображений, щелкая их по одному; держа Shift клавишу, вы можете выбрать несколько соседних изображений, щелкнув первое изображение и последнее.

3, нажмите Ctrl + A клавиши, чтобы выбрать все вставленные изображения в OneNote, а затем нажмите Ctrl + C ключи для их копирования.

4. Перейдите к листу в Excel и нажмите Ctrl + V ключи для вставки изображений в рабочий лист. Теперь все изображения вставлены вертикально, как показано на скриншоте слева.

5. Выберите любое из изображений и нажмите Ctrl + A ключи, чтобы выбрать все из них. Затем измените размер изображений сразу, введя новые числа в оба Ширина и Высота коробки в Размер группы на Формат таб. Смотрите скриншот:

Теперь все указанные изображения вставляются в Excel и массово изменяются до того же размера.

С помощью следующего кода VBA вы можете вставлять несколько изображений в файл Excel ячейка за ячейкой.

1. Выберите первую ячейку целевого диапазона, в который вы хотите вставить изображения.

2. Удерживайте ALT + F11 ключи, и он открывает Microsoft Visual Basic для приложений окно.

3. Нажмите Вставить > Модули, и вставьте следующий макрос в Окно модуля.

Sub InsertPictures()
'Update 20140513
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub

4, Затем нажмите F5 ключ для запуска этого кода.

5. В диалоговом окне «Открыть» откройте папку, содержащую изображения, которые вы хотите вставить, выберите несколько изображений, которые вы хотите вставить, и нажмите кнопку Откройте кнопка. И все выбранные изображения были импортированы в ваш выбор на основе размера ячейки. Смотрите скриншот:

Kutools for ExcelАвтора Импорт изображений Утилита может помочь вам быстро вставить несколько изображений в Excel в зависимости от размера ячейки или размера изображения. Вы также можете указать высоту и ширину изображений по своему усмотрению.

Kutools for Excel — Включает более 300 удобных инструментов для Excel. Полнофункциональная бесплатная пробная версия 30-день, кредитная карта не требуется! Get It Now

1. Нажмите Кутулс Плюс > Импорт / Экспорт > Импорт изображений, см. снимок экрана:

2. В Импорт изображений диалоговое окно, сделайте следующее:
(1) Укажите порядок отображения изображений из Заказ на импорт выпадающий список, вы можете выбрать Заполнять по вертикали ячейку за ячейкой or Заполнить по горизонтали ячейку за ячейкой.
(2) Нажмите Добавить кнопку, чтобы выбрать файлы изображений или папку для добавления изображений в список изображений. И все выбранные вами изображения будут перечислены в списке.
(3) Щелкните значок Размер импорта кнопка;

3, Теперь в Размер импортированного изображения В диалоговом окне вы можете выбрать размер изображения, который вам нужен. Смотрите скриншот: 4. После указания размера изображения нажмите OK чтобы закрыть это диалоговое окно и вернуться к Импорт изображений диалоговое окно, нажмите Импортировать кнопку для импорта изображений. 5. В новом диалоговом окне «Импорт изображений» выберите первую ячейку целевого диапазона, в который вы будете вставлять изображения, и нажмите кнопку OK кнопку. В настоящее время все выбранные вами изображения были вставлены в ваши ячейки из активной ячейки по вертикали или горизонтали. Смотрите правый снимок экрана:

Наблюдения и советы этой статьи мы подготовили на основании опыта команды Импорт изображений особенность Kutools for Excel предназначен для одновременной вставки пакета изображений с соответствующим размером ячейки, заданным размером или собственными размерами изображений в Excel. Получите бесплатную пробную версию!

Kutools for Excel также поддерживает драматическое Сопоставить Импорт изображений функция сопоставления изображений и содержимого ячеек и вставка совпадающих изображений только в Excel.

Kutools for Excel — Включает более 300 удобных инструментов для Excel. Полнофункциональная бесплатная пробная версия 30-день, кредитная карта не требуется! Get It Now

1. Выберите ячейки имени изображения, в которые вы хотите вставить соответствующие изображения, и нажмите Кутулс Плюс > Импорт / Экспорт > Сопоставить Импорт изображений. см. снимок экрана:

2. В появившемся диалоговом окне «Сопоставить импорт изображений» выполните следующие действия:
(1) Укажите порядок отображения изображений из Заказ на импорт раскрывающийся список;
(2) Нажмите Добавить кнопку, чтобы добавить изображения в список изображений. К вашему сведению, будут перечислены только совпадающие изображения.
(3) Затем нажмите Размер импорта кнопку.

3. Теперь в Размер импортированного изображения диалоговом окне вы можете выбрать размер изображения, соответствующий вашим потребностям, и щелкнуть Ok кнопка. Смотрите скриншот: 4. Теперь вы вернетесь к Импорт изображений диалоговое окно, нажмите Импортировать кнопку для импорта изображений. 5. В появившемся диалоговом окне «Сопоставить импорт изображений» укажите первую ячейку целевого диапазона, в который вы будете вставлять изображения, и нажмите кнопку OK кнопка. Смотрите скриншот: Пока все изображения вставляются в ячейки на основе их относительных имен. Смотрите правый снимок экрана:

Наблюдения и советы этой статьи мы подготовили на основании опыта команды Сопоставить Импорт изображений особенность Kutools for Excel может помочь пользователям Excel быстро фильтровать изображения на основе значений ячеек, а затем массово вставлять эти изображения. Кроме того, эти совпадающие изображения могут быть автоматически изменены до указанного размера или размера ячейки. Получите бесплатную пробную версию!

Ещё вопросы

• 0Как сделать видео лайтбокс «прорывом» из фрейма
• 1Google Drive Rest API для Android
• 0Перегрузка операторов сравнения для стеков
• 1Совпадение всех числовых вхождений без букв, следующих или предшествующих
• 1C # проверяет, является ли строка допустимым форматом WebProxy
• 1Объект с массивом себя
• 1Как извлечь первые 2 цифры всех чисел в столбце данных?
• 1Как смоделировать конкретные методы и направить остальные методы в конкретную реализацию интерфейса?
• 0Добавление кнопки закрытия в автоматическое всплывающее окно
• 1Нужна экспертиза регулярных выражений
• 1Паттерн наследования Python — как справиться с десериализацией
• 0Функция бесконечной прокрутки пользовательского интерфейса с поддержкой чанков
• 1Обновление родительского фрагмента в PopupWindow.dismiss
• 1JavaScript Анимация Холста с setInterval
• 0std :: вектор cv :: Mat
• 0Изменяет набор изображений по клику — Fotorama
• 0JPA ManyToMany использует группировку и пешеходные переходы для объединения данных
• 0Brightcove: ошибка CORS при использовании Play-Framework 2.3.x и Angular-JS
• 1iText делает весь рулон в цвете стола
• 1Как изменить что-то в View by ViewModel
• 1Программно заблокировать экран Windows Phone 8
• 1Ошибка изменения параметра sql
• 1Как выполнить сортировку на основе Comparator, сохранив исходную сортировку в Java
• 1Может ли Guice утверждать, что экземпляр синглтона не создается напрямую?
• 0Как изменить имя в jquery
• 0HTML, javascript — отображение входного значения для метки
• 0Поместите значения в скрытое поле, используя JQuery / Javascript
• 1indexoutofrangeexception в Datatable с Parallel.Foreach
• 1CodePrimitiveExpression и логические значения
• 1Несколько ключевых слов поиска по списку списков
• 1Java lwjgl & slick2d игровой интерфейс и худ?
• 1Добавление атрибута к узлам с помощью networkX
• 0Функция $ (window) .scroll не будет выполняться, если я не вызову ее вручную
• 0вызов контроллера AngularJS снаружи
• 1Как получить конкретное использование памяти для имени процесса?
• 0Не могу разобрать целое число в подготовленном MySQL выражении, используя util.format () в узле js
• 1расшифровка массива объектов в JSP
• 0CSS маржа и проблема заполнения
• 0JQuery сделать что-то зависит от пути URL
• 0центрирование div, даже если содержимое шире экрана
• 1Добавить 3D-эффекты в JTable
• 1Увеличение яркости экрана для активности
• 0Как предотвратить двойную отправку формы на уровне php или mysql?
• 1Повторное развертывание веб-приложения на Tomcat через Maven
• 0Неизвестный столбец «..» в «списке полей» — при вставке объектов в mySQL
• 1Вызов .jar из сценария оболочки
• 0Как мне разобрать этот большой XML-файл с XMLreader?
• 1Простой линейный график с альтаиром
• 1получить размер InputStream в Java