Вставка картинок и изображений в ячейки листа Excel

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

247199 просмотров

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Гость, 4 Дек 2022 - 14:22.#1

Добрый день!
Ваша
Sub ВставитьКартинку(
работает.
Вопрос: как удалить эту картинку?
Володя

APavlik, 9 Авг 2019 - 14:06.#2

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

Дано:
Есть таблица со списком учеников. Ученики каждый урок получают оценки (таблица Журнал оценок). Эти оценки используются для подсчета статистики посещаемости тех или иных мероприятий учениками. На главной странице при выборе нужной фамилии ученика появляется вся статистика по этому ученику.

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

Решение:
Понимаю, что нужно сделать лист, где таблица со столбцами: "Список учеников", "Одежда", "Награды" итд. А вот как сделать так что бы при настройке этой таблицы потом в основном разделе при выборе фамилии появлялись все картинки связанные с этим учеником да еще в нужных ячейках, не изменяя размеры ячеек - не знаю. Подскажите плиз, где и что почитать и посмотреть. Спасибо заранее!

Игорь (администратор сайта), 24 Июл 2019 - 21:26.#3

Тут нужно написать формулу, возвращающую случайное число от 1 до 10, и по этому числу получить путь к картинке.
А что дальше делать, использовать мою программу или же написать отдельный макрос из нескольких строк для вставки 1 картинки, - это уже не ваш выбор.

Гость, 24 Июл 2019 - 21:06.#4

Здравствуйте! Помогите решить следующую проблему: имеется 10 рисунков (с1,с2,с3,...с10). Необходимо чтобы загружалась на лист одна случайная картинка.

Игорь (администратор сайта), 20 Сен 2018 - 02:27.#5

Андрей, с вашей задачей справится готовая надстройка, - одну кнопку только нажать:
https://excelvba.ru/programmes/PastePictures

Андрей, 20 Сен 2018 - 02:21.#6

Подскажите пожалуйста, что нужно прописать, чтобы путь к файлу брался из ячейки и чтобы вставить не одно изображение в определенную ячейку, а несколько картинок.
Т.е. есть в ячейках AD2:AD2500 прописан пусть к файлу, нужно вставить эти картинки в ячейки C2:C2500.

Игорь (администратор сайта), 19 Май 2018 - 14:09.#7

Николай, используйте эту надстройку для вставки, всё будет грузиться
http://excelvba.ru/programmes/PastePictures

Николай, 19 Май 2018 - 13:51.#8

Все хорошо, но файлы формата *.png не грузятся.

Гость, 12 Окт 2017 - 19:31.#9

Здравствуйте,
спасибо большое за то что пытаетесь автоматизировать ручные процессы

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

Гость, 17 Май 2017 - 21:00.#10

Теперь понятно, почему в стандартном хэлпе об этих объектах нет ни слова. Спасибо за разъяснение.

Игорь (администратор сайта), 17 Май 2017 - 03:16.#11

Класс Picture остался в наследство от старых версий Excel, теперь он скрыт в объектной модели.
Не советую им пользоваться для вставки картинок, т.к. в новых версиях вставленные таким способом картинки не будут сохраняться внутри файла Excel
Где искать описание? Ну в гугле, наверное, но у меня навскидку не получилось какое-то внятное описание

Гость, 16 Май 2017 - 22:37.#12

Здравствуйте, Игорь. В ваших макросах используется объявление Dim ph As Picture. Подскажите, пожалуйста, где можно найти описание свойств и методов для таких объектов.

Игорь (администратор сайта), 16 Апр 2017 - 16:39.#13

На сайте есть макрос для скачивания картинок по ссылкам, - адаптируйте код под свои нужды:
http://excelvba.ru/code/DownloadPictures2

Гость, 16 Апр 2017 - 16:37.#14

Добрый день, Игорь! Ваша надстройка платная. А покупать мне ее точно не будут...к сожалению

Игорь (администратор сайта), 15 Апр 2017 - 19:33.#15

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

Гость, 15 Апр 2017 - 15:49.#16

Добрый день! Спасибо Игорь за ваш сайт!

Подскажите пожалуйста как применить этот макрос для задачи:
есть строки в эксель

|___A__|______________________________B____________________________________|___C___|
|255555|http://chart.apis.google.com/chart?cht=qr&chs=50x50&chl=255555%0D%0A&chld=H|0|_______|
|256666|http://chart.apis.google.com/chart?cht=qr&chs=50x50&chl=256666%0D%0A&chld=H|0|_______|
|257777|http://chart.apis.google.com/chart?cht=qr&chs=50x50&chl=257777%0D%0A&chld=H|0|_______|

как применить макрос что бы изображение по ссылке из столбца В вставлялось в соответствующую ячейку С.

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

Гость, 21 Дек 2016 - 14:20.#17

Set Pic = Sheets("Price ").Shapes.AddPicture(FileName, LinkToFile, SaveWithDocument , Left, Top, Width, Height)

FileName — строка, задающая имя файла, на основе которого создается рисунок
LinkToFile — допустимые значения: True (рисунок связан с файлом, на основе которого создан) и False (в противном случае)
SaveWithDocument — допустимые значения: True(сохраняется рисунок с рабочей книгой) и False (в рабочей книге сохраняется связь с рисунком, а не сам рисунок)
Left, Top — координаты левого верхнего угла объекта
Width, Height — ширина и высота объекта

Игорь (администратор сайта), 1 Ноя 2016 - 08:52.#18

Сергей, если почитаете комменты к статье, — найдете ответ на этот вопрос.

Сергей, 1 Ноя 2016 - 00:06.#19

Здравствуйте! Все работает и вставляет... НО!!! После изменения пути расположения картинок, и открытии вновь файла, на месте картинки пишется следующий текст: " Не удается отобразить связанный рисунок. Возможно, этот файл был перемещен, переименован или удален. Убедитесь, что ссылка указывает на правильный файл и верное размещение."
Пользуюсь Excel 2016. Почему он вставляет картинки как ссылки, и как это можно исправить?
Заранее спасибо!

Гость, 28 Сен 2016 - 09:10.#20

ну вставка происходит не в ячейку а поверх ее

Гость, 20 Июн 2016 - 23:43.#21

как с помощью макроса выбора изображения, вставить картинки, спасибо
Sub InsertPicture()
Dim FD As FileDialog
Dim iFileName As String
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.Filters.Clear
.Filters.Add "Âñå ðèñóíêè", "*.*"
.Filters.Add "JPG", "*.jpg"
.Filters.Add "Ðèñóíêè", "*.bmp"
.Filters.Add "PNG", "*.png"
.Filters.Add "tif", "*.tif"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path
.Title = "Äîáàâëåíèå ðèñóíêà"
.ButtonName = "Âñòàâèòü"
If .Show = False Then
'MsgBox "Âû íå óêàçàëè íóæíûé ôàéë!", 48, "Îøèáêà"
Exit Sub
Else
iFileName = Right(.SelectedItems(1), Len(.SelectedItems(1)) - InStrRev(.SelectedItems(1), "\"))
If Right(UCase(iFileName), 4) = ".XLS" Then iFileName = Left(iFileName, Len(iFileName) - 4)
End If
End With
Set FD = Nothing
ActiveSheet.Pictures.Insert(iFileName).Select - ВОТ тут я завершились мои познания в VBA ?????
End Sub

Игорь (администратор сайта), 12 Апр 2016 - 13:42.#22

Возможно, столбец с именами файлов неверно задан
Если сами не разберетесь, - звоните в скайп, помогу

Гость, 12 Апр 2016 - 13:39.#23

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

Игорь (администратор сайта), 12 Апр 2016 - 13:32.#24

Скачиваете и запускаете эту надстройку
http://excelvba.ru/programmes/PastePictures
Потом нажимаете в меню: Изображения - Сохранить картинки с листа в файлы

Гость, 12 Апр 2016 - 13:26.#25

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

Артур, 15 Фев 2016 - 19:43.#26

Отличная надстройка! Спасибо!!

Александр, 23 Окт 2015 - 14:38.#27

Подскажите, как прописать путь к ячейке в которой находится картинка для Image1 ? заранее, спасибо!

Александр, 18 Окт 2015 - 19:08.#28

Спасибо Вам огромное!

Игорь (администратор сайта), 18 Окт 2015 - 18:12.#29

Здравствуйте, Александр.
Событие Worksheet_Change реагирует только на ручное изменение ячеек (ну и на изменение макросом)
А чтобы на пересчёт реагировало, - тут надо использовать событие пересчета листа, - Worksheet_Calculate

Ну и код у вас ужасно длинный, - можно сделать проще:

Private Sub Worksheet_Calculate()
    On Error Resume Next
    Dim dVal(0 To 5), NewVal&, i&: Static LastVal&        ' переменная  LastVal& хранит значение и после завершения макроса
    dVal(0) = "1111111": dVal(1) = "1111000": dVal(2) = "1100110": dVal(3) = "1111001": dVal(4) = "1100111"
 
    NewVal = Val(Me.Range("BD49").Value)
    If NewVal <> LastVal Then        ' меняем видимость картинок, только если значение ячейки BD49 поменялось при пересчёте
        LastVal = NewVal
        For i = 1 To Len(dVal(NewVal)) ' перебираем все нолики и единички в dVal(2) = "1100110" (если NewVal = 2)
            Me.Shapes(i).Visible = CBool(Mid(dVal(NewVal), i, 1)) ' меняем видимость картинки
        Next
    End If
End Sub

Александр, 18 Окт 2015 - 17:27.#30

Здравствуйте.
Пытаюсь решить такую задачу: при изменении значений ячеек изменять видимость картинок.
когда вручную указываю значение - макрос включает и выключает картинки, а когда изменение значения ячейки вызвано результатом вычислений формул - макрос не работает. Пробовал указывать в макросе тип число, тип текст у переменной, которая принимает значение моей ячейки, саму ячейку умножал на 1 для получения типа число - бесполезно. Код следующий:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dVal As Integer
If Not Intersect(Target, ActiveSheet.Range("BD49")) Is Nothing Then
dVal = ActiveSheet.Range("BD49").Value

If dVal = 0 Then
With ActiveSheet
.Shapes.Item(1).Visible = True
.Shapes.Item(2).Visible = True
.Shapes.Item(3).Visible = True
.Shapes.Item(4).Visible = True
.Shapes.Item(5).Visible = True
.Shapes.Item(6).Visible = True
.Shapes.Item(7).Visible = True
End With

ElseIf dVal = 1 Then
With ActiveSheet
.Shapes.Item(1).Visible = True
.Shapes.Item(2).Visible = True
.Shapes.Item(3).Visible = True
.Shapes.Item(4).Visible = True
.Shapes.Item(5).Visible = False
.Shapes.Item(6).Visible = False
.Shapes.Item(7).Visible = False
End With

ElseIf dVal = 2 Then
With ActiveSheet
.Shapes.Item(1).Visible = True
.Shapes.Item(2).Visible = True
.Shapes.Item(3).Visible = False
.Shapes.Item(4).Visible = False
.Shapes.Item(5).Visible = True
.Shapes.Item(6).Visible = True
.Shapes.Item(7).Visible = False
End With

ElseIf dVal = 3 Then
With ActiveSheet
.Shapes.Item(1).Visible = True
.Shapes.Item(2).Visible = True
.Shapes.Item(3).Visible = True
.Shapes.Item(4).Visible = True
.Shapes.Item(5).Visible = False
.Shapes.Item(6).Visible = False
.Shapes.Item(7).Visible = True
End With

ElseIf dVal = 4 Then
With ActiveSheet
.Shapes.Item(1).Visible = True
.Shapes.Item(2).Visible = True
.Shapes.Item(3).Visible = False
.Shapes.Item(4).Visible = False
.Shapes.Item(5).Visible = True
.Shapes.Item(6).Visible = True
.Shapes.Item(7).Visible = True
End With

End If
End If
End Sub

Буду очень благодарен за помощь, рязъяснения в моих возможных заблуждениях.

Анастасия, 26 Авг 2015 - 16:42.#31

Спасибо большое, попробовала, все работает. Сори что загрузила глупым вопросом)

Игорь (администратор сайта), 26 Авг 2015 - 16:32.#32

Анастасия, в Excel есть кнопка «сжать рисунки» (при выделении одной или нескольких картинок на ленте появляется вкладка «Работа с рисунками», где присутствует эта кнопка)
Выделите все рисунки, нажмите кнопку, сохраните потом файл, - и всё.
Сделать это макросом, - не получится (только вручную)

Анастасия, 26 Авг 2015 - 13:48.#33

Игорь, здравствуйте! Не знаю сможете мне подсказать или нет, но была бы крайне признательна... У меня такая проблема. Из 1с выгружаю в эксел прайс (уже с картинками), причем программа настроена так, что окошко для картинки я могу задать любое и именно под размер этого окошка оно будет уменьшаться. НО по сути хотя оно и выводится в прайс небольшим окошком - вставляется не уменьшенными пикселями, а полноценно - просто маленького вида, т.е. при растягивании фото в эксел в ручную - я вижу полноценную большую качественную фотографию. Таким образом файл этот весит неимоверно много отправлять такой клиентам не реально, а как сжать его я не могу найти решения (перевод в сжатый пдф очень портит вид картинки, что даже особо и не поймешь что там изображено). Откровенно говоря ничего не понимаю в макросах... Но если есть какой-то вариант решения ыопроса - буду разбираться.

Гость, 3 Авг 2015 - 13:07.#34

Вопрос. При отправки таблицы с фотографиями через почту майл фотографии переворачиваются в таблице. Что делать?

Игорь, 16 Июл 2015 - 13:05.#35

Огромное спасибо.

Игорь (администратор сайта), 16 Июл 2015 - 12:59.#36

Игорь, вам подойдёт такая формула:
SUBSTITUTE({text},"/","")

Игорь, 16 Июл 2015 - 11:29.#37

Здравствуйте. У меня проблема с поиском картинок в папке. Имеется артикул вида "123/123", а название фото "123123". Возможно при поиске удаление символа "/" с помощью формулы для обработки имени файла в вкладке дополнительно? Если да до подскажите формулу. Заранее спасибо.

GetNight, 30 Июн 2015 - 20:03.#38

Можете ли помочь? У меня такая проблема... Я выгружаю из 1С таблицу как HTML.
После чего вызываю Aplication.Excel, открываю им этот файл (Open), и делаю SaveAs как XLS.
Все бы отлично, но картинка в таблице сохраняется как ссылка на неё (сама картинка не сохраняется в файл).
И при передаче XLS-файла в нем картинки нет, только надпись, что картинка была перемещена или удалена...

Можно ли изменить картинку в экселе таким образом, чтобы она при сохранении сохранилась в само тело XLS?
Если такая возможность есть, объясните, как это вообще делать (я надеюсь сам перекладу на 1С алгоритм, мне главное понять суть).
Заранее спасибо...

П.С. нужно для экспорта из старой 1С платформы (которую не разрешают обновлять) в которой была проблема экспорта в эксель (выгружался с ошибками).

Игорь (администратор сайта), 1 Май 2015 - 20:00.#39

Андрей, я бы так попробовал:
(моё предположение: если вы картинку поворачиваете, - ширина картинки должна подгоняться не под ширину ячейки, а под высоту ячейки.)

    If AdjustWidth Then        ' высоту не трогаем - изменяем ширину
        If K_picture < 1 Then        ' картинка с поворотом
            ' возможно, надо не разделить на коэффициент, а умножить
            ph.Height = PicRange.Width: ph.Width = ph.Height / K_picture
            ph.ShapeRange.Rotation = -90
        Else
            ' картинка без поворота
            ' код не меняем
            ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture
        End If
    End If

PS: код не проверял

Андрей, 1 Май 2015 - 19:07.#40

Большое спасибо за макрос!
Всё отлично работает!

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

    If AdjustPicture Then    ' ПОДГОНЯЕМ РАЗМЕРЫ ИЗОБРАЖЕНИЯ под ячейку (оптимальный вариант)
    
        ' если K_picture меньше 1, поворачиваем на 90 CCW
        If K_picture < 1 Then ph.ShapeRange.Rotation = -90

Картинка вставляется, вращается, но вставляется с сильным смещением вниз и влево.
Не могу понять, что я делаю не так.

Игорь (администратор сайта), 18 Апр 2015 - 17:55.#41

Здравствуйте, Ольга.
Готового макроса нет, - под каждый тип файла надо делать отдельный макрос,
и эти макросы получатся очень сложными (дорогими)

Куда проще перевести (вручную или спец программами) PDF и JPG в формат Word, - и подставлять данные в этот шаблон Word
Для этой задачи есть готовое решение: http://excelvba.ru/programmes/FillDocuments
Можно сделать вывод результата в формат PDF (в вышеуказанной надстройке есть такая опция)
Если очень надо, - результат (заполненный документ Word или Excel) можно преобразовать и в картинку (JPG), написав отдельный макрос.

Ольга Белякова, 18 Апр 2015 - 17:05.#42

Здравствуйте, есть ли макрос для вставки значений из Excel в файлы PDF, JPG (или другие картинки)?

Вадиссимус, 22 Авг 2014 - 23:33.#43

Спасибо.

Игорь (администратор сайта), 22 Авг 2014 - 22:41.#44

замените Selection на pic

Вадиссимус, 22 Авг 2014 - 18:08.#45

Спасибо. То, что Эксель вставит картинку ссылкой - не страшно. Даже хорошо. Изменив картинку изменю ее и в файле.
Подскажите, пожалуйста, как сдвинуть картинку чуть влево и чуть вверх.
До этого использовал:
Selection.ShapeRange.IncrementTop -4.5
Selection.ShapeRange.IncrementLeft -24.75
Но с новым кодом не работает.

Игорь (администратор сайта), 22 Авг 2014 - 15:35.#46

Макрос для обрезки картинки:

Sub CropImage()
    Filename$ = "C:\Users\Игорь\Desktop\IMG_12082014_222844.png"
 
    Dim pic As Picture
    Set pic = ActiveSheet.Pictures.Insert(Filename$) ' вставка на лист
    
    With pic.ShapeRange.PictureFormat ' сколько с какой стороны обрезать
        .CropLeft = 50
        .CropTop = 60
        .CropBottom = 70
        .CropRight = 80
    End With
End Sub

PS: в Excel 2010 (и новее) ваш код вставит картинку именно ссылкой (а не внедрит её в книгу Excel)
Тут где-то ниже в комментах я приводил пример кода, как надо вставлять изображение, чтобы оно с файлом сохранилось

Вадиссимус, 22 Авг 2014 - 14:19.#47

Друзья. Я вставляю картинку картинкой, а не ссылкой. Макрос просто записал.

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

Код такой:
Sub Макрос3()
Range("C5").Select
ActiveSheet.Pictures.Insert( _
Excel.Application.ActiveWorkbook.Path & "\Превью А.jpg" _
).Select
Selection.ShapeRange.IncrementTop -4.5
Selection.ShapeRange.IncrementLeft -24.75
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 22.6299212598
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 300
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 164
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0

Range("O5").Select
ActiveSheet.Pictures.Insert( _
Excel.Application.ActiveWorkbook.Path & "\Превью Б.jpg" _
).Select
Selection.ShapeRange.IncrementTop -4.5
Selection.ShapeRange.IncrementLeft -24.75
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 4.5354330709
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 300
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 164
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
End Sub

Посоветуйте, пожалуйста, как сделать макрос обрезки картинки.

Константин, 23 Июл 2014 - 15:46.#48

Спасибо

Игорь (администратор сайта), 19 Июл 2014 - 23:55.#49

Здравствуйте, Константин
Моя программа для этих целей не предназначена.
Решение (с подробной инструкцией) легко найти в интернете, если в Яндекс вбить фразу «Excel выбор фото из выпадающего списка»

Константин, 18 Июл 2014 - 22:49.#50

Скажите пожалуйста, как можно вставлять изображение из из этого же файла excel (например, с другого листа)? Задача - нужно что бы просто менялся логотип на бланке при выборе значения из списка. И что бы этот файл был автономный (не привязан к диску/папке на определенном компьютере)

Вставка картинок и изображений в ячейки листа Excel

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL