Вставка картинки в ячейку

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

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

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

13.05.2025 18:20:56

Добрый день форумчане.

Есть простая на первый взгля задача, но решения не могу найти:
Есть Книга Эксель, которую генерирует промышленная программа. В этой Книге есть лист "Список всех деталей", и в столбце "B" Миниатюра нахояться сгенерированные эскизы (картинки) . Для дальнейшей работы с этими эскизами, в других таблицах, необходимо что бы они были вложенны в ячейку. Сейчас я выделяю последовательно каждую картинку отдельно и нажимаю "вставить в ячейку".
Генерирует по несколько сотен картинок в таблице. Часами вношу в ячейки. Если кто может, помогите пожалуйста.

Пример прикрепляю как есть (как сгенерировала программа).

Что бы не развоить много тем на форуме, спрошу здесь же вопрос по макросам Удалено. Вопрос к заявленной теме не имеет никакого отношения. Модератор

Прикрепленные файлы

13.05.2025 20250513001.xlsx (31.74 КБ)

Изменено: Sanja - 14.05.2025 04:31:49 (Одна тема - один вопрос)

Igor67

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

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

13.05.2025 21:50:44

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

Скрытый текст

Прикрепленные файлы

Рисунок двигаем.xlsm (34.22 КБ)

Deadhunt1

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

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

13.05.2025 22:29:11

Igor67, На самом деле нужно немного другое, нужно что бы просто сработала вот эта (пример) команда с каждым рисунком, и он поместился в саму ячейку под рисунком. Размер ячейки и рисунка менять не нужно.

В примере я применил команду к первым двум картинкам.

Прикрепленные файлы

Рисунок двигаем.xlsm (46.37 КБ)

Sanja

Модератор

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

14.05.2025 05:38:07

Проверьте

Код

Sub AddPicToCell()
Dim iShape As Shape
On Error Resume Next
Application.ScreenUpdating = False
For Each iShape In ActiveSheet.Shapes
  If iShape.Name <> "btMacro" Then
    iShape.Select
    iShape.PlacePictureInCell
  End If
Next
Application.ScreenUpdating = True
End Sub

Прикрепленные файлы

Рисунок двигаем.xlsm (37.54 КБ)

Согласие есть продукт при полном непротивлении сторон

Deadhunt1

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

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

14.05.2025 11:58:38

Цитата
написал: Проверьте

Все работает как часы!
Благодарю за ваше умение и старание !

Изменено: Deadhunt1 - 14.05.2025 11:58:53

Sanja

Модератор

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

14.05.2025 12:02:21

Цитата
Deadhunt1 написал: ...и старание !

Прям как запись в тетрадке за домашнее задание

. Вы наверное учитель?)

Согласие есть продукт при полном непротивлении сторон

Deadhunt1 Пользователь Сообщений: 15 Регистрация: 21.04.2018	#7 16.05.2025 07:15:33 Не угадали, тружусь газорезчиком . Просто иногда сложно выразить восхищение возможностям человеческого ума!

Читают тему