Требуется макросом поместить изображение (картинку) на лист Excel?

Используйте функцию ВставитьКартинку, которая позволит вам вставить картинку в выбранную ячейку (или диапазон ячеек).

При вызове функции можно задать дополнительные дополнительные параметры, указав, следует ли подгонять картинку (или ячейку) по высоте и ширине.

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

Кроме того, надстройка для вставки изображений в Excel умеет загружать картинки из интернета (по ссылкам в таблице Excel)

Бесплатно скачать надстройку вставки картинок в Excel

В этом примере демонстрируются возможные варианты применения функции вставки картинок:

Sub ПримерВставкиИзображенийНаЛист()

    ПутьКФайлуСКартинками = "D:\BMP\AboutForm.jpg"    ' полный путь к файлу изображения

    ' вставка картинки в ячейку A5 (размеры картинки и ячейки не меняются)

    ВставитьКартинку Cells(5, 1), ПутьКФайлуСКартинками 

    ' вставка картинки в ячейку F5 (ячейка подгоняется по ШИРИНЕ под картинку)

    ВставитьКартинку Cells(5, 6), ПутьКФайлуСКартинками, True

    ' вставка картинки в ячейку E1 (ячейка подгоняется по ВЫСОТЕ под картинку)

    ВставитьКартинку [e1], ПутьКФайлуСКартинками, , True

    ' вставка картинки в ячейку F2 (ячейка принимает размеры картинки)

    ВставитьКартинку Range("F2"), ПутьКФайлуСКартинками, True, True

    ' =========================================

    ' вставка картинки в ячейку F5 (картинка подгоняется по ШИРИНЕ под ячейку)

    ВставитьКартинку Cells(5, 6), ПутьКФайлуСКартинками, True, , True

    ' вставка картинки в ячейку E1 (картинка подгоняется по ВЫСОТЕ под ячейку)

    ВставитьКартинку [e1], ПутьКФайлуСКартинками, , True, True

    ' вставка картинки в диапазон a2:e3 (картинка вписывается в диапазон)

    ВставитьКартинку [a2:e3], ПутьКФайлуСКартинками, True, True, True

End Sub

А вот и сама функция (скопируйте этот код в стандартный модуль, чтобы иметь возможность вставки картинок одной строкой кода из любого макроса):

Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String, _

                     Optional ByVal AdjustWidth As Boolean, _

                     Optional ByVal AdjustHeight As Boolean, _

                     Optional ByVal AdjustPicture As Boolean = False)

    ' ==========  функция получает в качестве параметров:  ====================

    ' PicRange - прямоугольный диапазон ячеек, поверх которого будет расположено изображение

    ' PicPath - полный путь к файлу картинки (файл в формате JPG, BMP, PNG, и т.д.)

    ' AdjustWidth - если TRUE, то включен режим подбора ширины (подгонка по высоте)

    ' AdjustHeight - если TRUE, то включен режим подбора высоты (подгонка по ширине)

    ' AdjustPicture - если TRUE, то подгоняются размеры картинки под ячейку,

    '                 если FALSE (по умолчанию), то изменяются размеры ячейки

    On Error Resume Next: Application.ScreenUpdating = False

    ' вставка изображения на лист

    Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)

    ' совмещаем левый верхний угол ячейки и картинки

    ph.Top = PicRange.Top: ph.Left = PicRange.Left

    K_picture = ph.Width / ph.Height    ' вычисляем соотношение размеров сторон картинки

    K_PicRange = PicRange.Width / PicRange.Height    ' вычисляем соотношение размеров сторон диапазона ячеек

    If AdjustPicture Then    ' ПОДГОНЯЕМ РАЗМЕРЫ ИЗОБРАЖЕНИЯ под ячейку (оптимальный вариант)

        ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину

        If AdjustWidth Then ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture

        ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту

        If AdjustHeight Then ph.Height = PicRange.Height: ph.Width = ph.Height * K_picture

        ' AdjustWidth=TRUE и AdjustHeight=TRUE: вписываем картинку в ячейку (без соблюдения пропорций)

        If AdjustWidth And AdjustHeight Then ph.Width = PicRange.Width: ph.Height = PicRange.Height

    Else    ' ИЗМЕНЯЕМ РАЗМЕРЫ ЯЧЕЙКИ под размеры изображения (нежелательно при вставке НЕСКОЛЬКИХ картинок...)

        If AdjustWidth Then    ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину

            PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth * ph.Width / PicRange.Cells(1).Width

            While Abs(PicRange.Cells(1).Width - ph.Width) > 0.1    ' точный подбор ширины ячейки

                PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)

            Wend

        End If

        If AdjustHeight Then    ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту

            PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height

            While Abs(PicRange.Cells(1).Height - ph.Height) > 0.1    ' точный подбор высоты ячейки

                PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)

            Wend

        End If

    End If

End Sub

• 201477 просмотров