При оптимизации своего нелегкого труда - продажи, решил подготовить визуальную таблицу с описанием и всеми характеристиками. Все здорово конечно получилось, но столкнулся с двумя проблемами, которые не могу никак решить, а именно:
1. Смена картинки в листе Описание для каждой коллекции при нажатии на соответствующую картинку на Главной или же в любой выбранной коллекции.
2. Я так понимаю нужно как-то привязать картинки к ячейкам?
3. В зависимости от смены картинки на листе с Описанием нужно чтобы в одной и той же ячейке (Столбец "А" "№№№) менялся номер артикула.
Отсюда вопрос, откуда начинать копать, чтобы закончить уже этот файл?
Без макросов, в интернете есть такой пример (смотрите прикреплённый файл). В нём, в B7 выбирайте нужный пункт и будет изменяться рисунок.
В вашем файле такое можно сделать или у вас другой принцип?
Пример посмотрел, но он мне не подходит.
Не знаю, есть ли другие способы решения вашей задачи без макросов.
Если формулами нельзя, то можно попробовать сделать макросами.
Черт, у меня все-таки была надежда сделать это без макросов!
Много времени это займет?
Изображения можно так вставлять с помощью макроса.
У изображения нужно сделать:
1) имя сделайте по такой схеме "Имя листа/Уникальное имя рисунка". Например: Главная/Рисунок 1. Имя можно изменить так: щёлкните по рисунку левой мышью - слева от строки формул укажите имя и нажмите Enter;
2) в описании пишите имя листа, куда надо копировать изображение. Описание находится здесь: щёлкните по изображению правой мышью - Размер и свойства... - раздел "Замещающий текст" - Описание;
3) изображению нужно назначить макрос. Для всех изображений будет один макрос. Сейчас в файле это метод "Программа".
У изображений нужно убрать гиперссылки, иначе макрос не запускается.
В файле я сделал пример для первого изображения на листе "Главная".
Чтобы выделить изображение и начать его настраивать, нажмите и удерживайте Ctrl и щёлкайте по нему левой мышью.
После открытия файла не забудьте разрешить макросы.
Сам макрос:
Макрос
Sub Макрос()
Dim shSrc As Worksheet, shRes As Worksheet
Dim shpSrc As Shape, shpRes As Shape
Set shSrc = Worksheets(Split(Application.Caller, "/")(0))
Set shpSrc = shSrc.Shapes(Application.Caller)
Set shRes = Worksheets(shpSrc.AlternativeText)
shRes.Shapes(1).Delete
shpSrc.Copy
shRes.Range("B2").PasteSpecial
Set shpRes = shRes.Shapes(1)
shpRes.LockAspectRatio = False
shpRes.Width = shRes.Range("B2:C20").Width
shpRes.Height = shRes.Range("B2:C20").Height
End Sub
РАБОТАЕТ!!! Спасибо! Гениально! Дописал еще "shRes.Activate" в конце т.к. перехода на нужную страницу не было, но сути дела не меняет! Жаль конечно что все гиперссылки придется рубить, столько времени на них убил... Но результат того стоил.
Я могу к тебе обратиться со вторым вопросом, как быть с артикулами? Я могу обозвать все картинки соответствующими артикулами, а вот как вывести "название" (он же артикул) в соответствующую ячейку? Выручишь неимоверно!
Я добавил в описание изображения артикул. Теперь в описании пишите по такой схеме: имя листа, на которой надо вставить/Артикул. Пример: Alignment описание/арт. 1
Макрос
Sub Макрос()
Dim shSrc As Worksheet, shRes As Worksheet
Dim imgSrc As Shape, imgRes As Shape
Dim spl
'1. Application.Caller вернёт имя рисунка, по которому щёлкнули.
' Имя рисунка можно посмотреть так: щёлкните по рисунку левой мышью -
' посмотрите слева от строки формул.
' Split разобьёт имя рисунка на части по слешу и будет получен массив, состоящий из двух элементов.
' Порядковый номер первого элемента в таком массиве 0.
spl = Split(Application.Caller, "/")
'2. Присваиваем листу-источнику программное имя "shSrc", чтобы удобно обращаться к нему.
' spl(0) - это первый элемент массива "spl" и в нём находится имя листа, взятое из имени рисунка.
Set shSrc = Worksheets(spl(0))
'3. Присваивание программного имени "imgSrc" рисунку, по которому щёлкнули.
Set imgSrc = shSrc.Shapes(Application.Caller)
'4. Разбивка на части описания рисунка по слешу
' и присваивание программного имени "shRes" листу-результату.
spl = Split(imgSrc.AlternativeText, "/")
Set shRes = Worksheets(spl(0))
'5. Удаление на листе-результате рисунка.
shRes.Shapes(1).Delete
'6. Копирование рисунка из листа-источника и вставка его на лист-результат.
imgSrc.Copy
shRes.Range("B2").PasteSpecial
'7. Разбивка текста в описании рисунка на части по слешу и запись артикула в эксель-ячейку.
' 2 - означает, что текст будет разбит на две части. Это нужно на случай,
' если в самом артикуле будут слеши, чтобы артикул не разбился на части.
spl = Split(imgSrc.AlternativeText, "/", 2)
shRes.Range("A10").Value = spl(1)
'8. Присваивание программного имени вставленному рисунку.
Set imgRes = shRes.Shapes(1)
'9. Убираем галочку "Сохранять пропорции", чтобы задать нужную высоту и ширину.
' И задаём размеры рисунку по размеру занимаего им эксель-фрагмента.
imgRes.LockAspectRatio = False
imgRes.Height = shRes.Range("B2:C20").Height
imgRes.Width = shRes.Range("B2:C20").Width
'10. Переход на лист-результат.
shRes.Activate
End Sub
Всё работает как часы! Мои искренние благодарности и почтение!