Картинка в примечании к ячейке
Хотите использовать фотографию или рисунок в качестве примечания к ячейке? Например, вот так:
Это может быть удобно при создании списков людей с их фотографиями, прайс-листов с изображениями товаров и т.п.
Способ 1. Одиночная вставка
- Щелкните по ячейке, в которую будем вставлять примечание правой кнопкой мыши и выберите в контекстном меню Добавить примечание (Add comment).
- Чтобы примечание во время настройки постоянно не пропадало, щелкните по ячейке правой кнопкой мыши и выберите команду Отобразить/Скрыть примечание (Show/Hide Comment).
- Щелкните правой кнопкой мыши по штрихованной рамке вокруг примечания (штриховка при этом должна превратиться в точки) и выберите в контекстном меню команду Формат примечания (Format Comment).
- В открывшемся окне перейдите на вкладку Цвета и линии (Colors and Lines) и из раскрывающегося списка Цвет (Color) выберите опцию Способы заливки (Fill Effects):
- В появившемся окне перейдите на вкладку Рисунок (Picture) и, щелкнув по кнопке Рисунок (Select Picture), выберите нужный файл с изображением. Дополнительно можно установить флажок Сохранять пропорции рисунка (Lock picture aspect ratio).
- Жмем ОК во всех окнах и, возможно, немного подгоняем размеры примечания, чтобы картинку было хорошо видно.
Способ 2. Вставка оптом
Как видно из первого способа, вставка одной картинки в одно примечание - процедура хоть и не сложная технически, но не очень-то быстрая. Поэтому для вставки картинок в массовых масштабах (например, изображений товаров в прайс) лучше использовать простой макрос. В качестве исходных данных примем, что у нас есть:
- список наименований товаров в прайс-листе, к ячейкам которых мы и хотим добавить примечания
- список путей к файлам изображений этих товаров (его можно, кстати, формировать тоже автоматически с помощью вот такого макроса).
Выглядит все это, допустим, так:
Откройте редактор Visual Basic (сочетание клавиш Alt+F11), вставьте новый пустой модуль (меню Insert - Module) и скопируйте туда текст этого макроса:
Sub InsertPicturesInComments()
Dim rngPics As Range, rngOut As Range
Dim i As Long, p As String, w As Long, h As Long
Set rngPics = Range("B1:B5") 'диапазон путей к картинкам
Set rngOut = Range("A1:A5") 'диапазон вывода примечаний
rngOut.ClearComments 'удаляем старые примечания
'проходим в цикле по ячейкам
For i = 1 To rngPics.Cells.Count
p = rngPics.Cells(i, 1).Value 'считываем путь к файлу картинки
w = LoadPicture(p).Width 'и ее размеры
h = LoadPicture(p).Height
With rngOut.Cells(i, 1)
.AddComment.Text Text:="" 'создаем примечание без текста
.Comment.Visible = True
.Comment.Shape.Select True
End With
With rngOut.Cells(i, 1).Comment.Shape 'заливаем картинкой
.Fill.UserPicture p
.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
.ScaleHeight h / w * 1.8, msoFalse, msoScaleFromTopLeft 'корректируем размеры
End With
Next i
End Sub
Диапазоны rngPics и rngOut можно, естественно, заменить на свои.
Теперь осталось открыть окно управления макросами (Alt+F8) и запустить наш созданный макрос кнопкой Выполнить (Run). Результат будет примерно такой:
Красота!
P.S.
- Вставленные в примечания картинки и фотографии будут неизбежно утяжелять файл. При большом количестве изображений имеет смысл их заранее обработать (сжать до нужных размеров, оптимизировать цветовую гамму и разрешение) с помощью специальных программ.
- Отобразить или скрыть сразу все примечания можно на вкладке Рецензирование - Показать все примечания (Review - Show all comments).
- Удалить все примечания из выделенных ячеек можно на вкладке Главная - Очистить - Примечания (Home - Clear - Comments).
Ссылки по теме
При вставке в новый лист скопированной ячейки, которая имеет примечание с рисунком, осуществлялся бы автоматический перенос и примечания.
Т.е. при вставке в новое место скопированных ячеек с текстом необходимо их графическое "отображение". Спасибо.
Если это xls, то пересохраните его сначала в xlsx.
а можно добавить в Примечание данные из таблицы находящейся на другом листе. Объясню для чего это нужно. В таблице с данными находятся с десяток документов которые переодически обновляются. В ячейку где высвечивается Примечание необходимо вставить порядковый номер этих документов. Каждый раз прыгать с одной страницы на другую не совсем удобно. Помогите если это возможно.
Спасибо Георгий!
Макрос отлично работает, но я столкнулся с небольшой проблемой: скрипт так же добавляет примечание в следующую (пустую) после последней заполненной ячейки из диапазона, ругаясь при этом на строчку ".Fill.UserPicture p"
У вас диапазоны точно правильно прописаны в 6 и 7 строчках? Различий в их размерах нет? Если не разберетесь сами, то шлите ваш файл мне на почту - посмотрю, ага?
Прием классный. Но есть нюанс. А именно, что физический вес файла будет увеличиваться пропорционально увеличивающемуся суммарному весу загружаемых в него картинок. Для файла с сотней позиций это еще сносно, но если в прайсе несколько тысяч позиций...
А теперь, уважаемые знатоки, вопрос. Возможно ли запрограммировать макрос таким образом, чтобы при наведении курсора на ячейку с примечанием, макрос подгружал изображение из папки на сервере в интернете? А после завершения работы с файлом загруженные изображения просто удалялись бы с компьютера. Такое решение стало бы настоящей находкой для тех, кто рассылает прайсы с многокилометровой номенклатурой.
Первый раз обращаюсь лично к Вам (до этого пользовался ссылками на Ваши советы). Можно ли в Excel 2007 установить самому место появления примечания, а не только справа вверху от соответствующей ячейки.
Спасибо!
(думаю что этот код являлся бы промежуточным для перехода к более сложному варианту с
Sub test() Dim s As String s = Application.GetOpenFilename("Image Files (*.bmp;*.gif;*.jpg;*.jpeg)," & "*bmp;*gif;*.jpg;*.jpeg") ' - вызываем окно, в которой выберем нашу картинку ActiveCell.AddComment.Text "Текст примечания"'- при необходимости можем написать текст примечания ActiveCell.Comment.Shape.Fill.UserPicture s End SubПопробовал макрос, выдается ошибка:
Run time error '91'
Objekt variable or With block variable not found
Отсыл в макросе идет к строке:
.Comment.Visible = True
Подскажите, если не сложно где я не прав, сам вряд ли быстро разберусь?
Спасибо за помощь!
А есть ли возможность сделать так, чтобы в одно примечание прицеплялась многокадровая gif-ка и кадры внутри примечания сменялись?
И еще: есть ли возможность, чтобы примечание формировалось только когда на ячейке стоит курсор (ячейка выделена) и удалялось после того, как перешли на другую ячейку.
И совсем как начинающий спрошу: какими командами можно управлять размерами такого примечания и его месторасположением относительно выделенной ячейки.
Заранее спасибо!
2. Автоматически создавать или удалять примечание при выделении ячейки можно только макросом, через обработку события выделения диапазона.
3. Например ActiveCell.Comment.Shape.ScaleWidth и ActiveCell.Comment.Shape.ScaleHeight. А вообще - справка вам в помощь, помнить все свойства всех объектов VBA нереально. Ставите в коде курсор на слово Comment и жмете F1 - увидите полное описание со всеми параметрами.
Как добавлять фото по одному в разные ячейки используя этот код
Sub test_add_foto() Dim s As String Dim w As Long, h As Long s = Application.GetOpenFilename("Image Files (*.bmp;*.gif;*.jpg;*.jpeg)," & "*bmp;*gif;*.jpg;*.jpeg" _ ' - âûçûâàåì îêíî, â êîòîðîé âûáåðåì íàøó êàðòèíêó ActiveCell.AddComment.Text "" '- ïðè íåîáõîäèìîñòè ìîæåì íàïèñàòü òåêñò ïðèìå÷àíèÿ ActiveCell.Comment.Shape.Fill.UserPicture s ActiveCell.Comment.Shape.ScaleWidth 1, msoFalse, msoScaleFromTopLeft ActiveCell.Comment.Shape.ScaleHeight 3, msoFalse, msoScaleFromTopLeft End Subкак єто исправить?
Sub add_foto() Dim s As String Dim w As Long, h As Long s = Application.GetOpenFilename("Image Files (*.bmp;*.gif;*.jpg;*.jpeg)," & "*bmp;*gif;*.jpg;*.jpeg" _ ' - âûçûâàåì îêíî, â êîòîðîé âûáåðåì íàøó êàðòèíêó w = LoadPicture(s).Width 'è åå ðàçìåðû h = LoadPicture(s).Height ActiveCell.AddComment.Text "" '- ïðè íåîáõîäèìîñòè ìîæåì íàïèñàòü òåêñò ïðèìå÷àíèÿ ActiveCell.Comment.Shape.Fill.UserPicture s ActiveCell.Comment.Shape.ScaleWidth 1, msoFalse, msoScaleFromTopLeft ActiveCell.Comment.Shape.ScaleHeight h / w * 1.8, msoFalse, msoScaleFromTopLeft 'êîððåêòèðóåì ðàçìåðû End SubА вообще - спасибо за макрос, может кому пригодится.
Если удалять либо перемещать столбцы на листе слетают размеры картинки в примечании и вся работа идет на смарку.
Помогите что сделать или как изменить макрос???
Прошу помочь. Очень прошу.
Цель: Вставка в диапазон
Set rngOut = Range("A1:A5") "диапазон вывода примечаний
НЕ примечания, а именно сами изображения.
Уровень знаний в VBA - методом "тыка"
Я удалил этот кусок:
With rngOut.Cells(i, 1)
.AddComment.Text Text:="" 'создаем примечание без текста
.Comment.Visible = True
.Comment.Shape.Select True
End With
НЕ могу изменить эту часть под свои нужды (вставка изображения в ячейку а не в примечание к ячейке)
With rngOut.Cells(i, 1).Comment.Shape 'заливаем картинкой
.Fill.UserPicture p
.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
.ScaleHeight h / w * 2#, msoFalse, msoScaleFromTopLeft 'корректируем размеры
End With
Очень прошу помочь. Заранее благодарен!
Спасибо создателю сайта. Очень облегчает жизнь.
Если есть нормальные решения, то интересно почитать.
Спасибо!
Если использовать исходный код, то ошибка "Fail not found".
Если закомментировать (см. ниже), то код отрабатывает, НО картинки в примечании расстянутые.
w = LoadPicture(p).Width 'и ее размеры
h = LoadPicture(p).Height
.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
.ScaleHeight h / w * 1.8, msoFalse, msoScaleFromTopLeft 'корректируем размеры
Заранее спасибо!
Спасибо!!!
подскажите пожалуйста, как зафиксировать определенную область выпадающей картинки вложенной в комент. Я хочу чтоб выпадающие окно было всегда на одном месте сверху как показал на .
Спасибо
Изначальный код текста:
Set rngPics = Range ("B1:B5";) диапазон путей к картинкам
Set rngOut = Range ("A1:A5";) диапазон вывода примечаний
а мне нужен диапазон:
Set rngPics = Range (B1:B5;B8:B9;B11:B12;) - но простым путем перечисления диапазона макрос не работает
Set rngOut = Range (A1:A5;A8:A9;A11:A12;)
Столкнулась с проблемой. Очень прошу помочь. Есть большой прайс. Есть ссылки на картинки. Надо сделать, чтобы вместо ссылок появились картинки.
Взяла Вашу обработку, но выдается ошибка на эти размеры
w = LoadPicture(p).Width
h = LoadPicture(p).Height
"can"t execute code in break mode"
Изучаю VBA методом тыка)
К понедельнику надо все сделать, вручную при всем желании не успею(((
помогите пожалуйста
Огромное вам спасибо за этот супер макрос! Вы могли бы подсказать, как в макросе вставки картинок по одной
1) установить галочку "Сохранять пропорции рисунка"
2) установить размеры картинки побольше
Подскажите пожалуйста.
В форматированную таблицу (умная таблица), можно ли вставить изображение в примечание?
Мне ни как не удается.
при открывании "формата примечания" у меня только одна вкладка "шрифт", есть "цвет", но так тупо можно только цвет выбрать, никаких доп. "Другие цвета или способы заливки" нет.
что делать?
формат вроде Лист Microsoft Excel (.xlsx)
не понимаю почему не получается(((
Одну картинку вставил 1-м способом в ячейку, а другую картинку в следующую ячейку тем же способом не дает вставить - выдает ошибку:
Bad Request - Request Too Long
HTTP Error 400. The size of the request headers is too long.
Как обойти или где я косячу ?