Доброго дня всем читающим!
Есть код, полученный в этом же форуме (за что автору отдельное спасибо!), который хотелось бы модифицировать, но моих знаний для этого не хватает.
Модуль берёт название картинки(в виде артикул.jpg) из ячейки, добавляет его в конец прописанного пути R:\ФОТО\BOSCH\150\ и загружает картинку в ячейку справа от ячейки с названием.
Хочется, чтобы путь тоже был "составным", так как папок с картинками по брендам много, и каждый раз переписывать путь неудобно.
Надо чтобы название папки, в данном конкретном случае "BOSCH", бралось из ячейки слева от ячейки с названием картинки.
Результат должен выглядеть, как в приложенном файле.
Sub InsertPictures()
Const PATH = "R:\ФОТО\BOSCH\150\" 'папка с картинками
Dim c As Range
For Each c In Selection
With ActiveSheet.Shapes.AddPicture(PATH & c, _
msoFalse, msoTrue, c(, 2).Left, c(, 2).Top, 100, 100)
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную высоту
.ScaleWidth 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную ширину
c.RowHeight = .Height + 10 'подстроить высоту строки
End With
Next
End Sub
Совсем идеальным вариантом было бы, если и расширение файла с картинкой (.jpg) добавлялось бы в конец пути в коде, чтобы не создавать столбец дополнительно а использовать два столбца бренд/артикул)
Здравствуйте,
закомментируйте(Удалите) строку, где добавляется Патч
и перед With ActiveSheet...
добавьте
PATH = c.Offset(, -1).value
Но путь в ячейке 1 должен быть полным и заканчиваться слэшем "\".
Либо надо составлять дополнительный справочник путей для разных наименований и обращаться к нему
Спасибо!
Вполне рабочий вариант! Жаль, не удалось обойтись имеющимися столбцами, но требуемый выстраивается просто, так что - результат достигнут.
Кстати, у меня срабатывает как раз без слэша в конце, т.е. '...jpg' и всё
Цитата: boa от 03.08.2018, 12:45
Но путь в ячейке 1 должен быть полным и заканчиваться слэшем "\".
Цитата: runner от 03.08.2018, 11:41
Совсем идеальным вариантом было бы, если и расширение файла с картинкой (.jpg) добавлялось бы в конец пути в коде, чтобы не создавать столбец дополнительно а использовать два столбца бренд/артикул)
Не знаю всей логики составления пути к файлу, но могу предположить вариант
Filename = "R:\ФОТО\" & c.Offset(, -1).Value & "\150\" & c.Value & ".jpg"соответственно "Filename" заменит в коде "PATH & c"
Всё ли я так сделал?
не срабатывает.
Логика пути - общий ресурс диск R:, на нём раздел ФОТО, в нём папки именованные названием бренда, внутри полноразмерные фото в формате артикул.jpg и папка под названием "150" в которой аналогичные фото с такими же названиями, но с максимальной высотой в 150 точек.
Собственно их и предполагается загружать в таблицу.
Sub InsertPictures()
Dim c As Range
For Each c In Selection
With ActiveSheet.Shapes.AddPicture(Filename = "R:\ФОТО\" & c.Offset(, -1).Value & "\150\" & c.Value & ".jpg", _
msoFalse, msoTrue, c(, 2).Left, c(, 2).Top, 100, 100)
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную высоту
.ScaleWidth 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную ширину
c.RowHeight = .Height + 10 'подстроить высоту строки
End With
Next
End Sub
Цитата: runner от 03.08.2018, 14:11
Всё ли я так сделал?
не совсем
Sub InsertPictures()
Dim c As Range
dim Filename as string
For Each c In Selection
Filename = "R:\ФОТО\" & c.Offset(, -1).Value & "\150\" & c.Value & ".jpg"
With ActiveSheet.Shapes.AddPicture(Filename, _
msoFalse, msoTrue, c(, 2).Left, c(, 2).Top, 100, 100)
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную высоту
.ScaleWidth 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную ширину
c.RowHeight = .Height + 10 'подстроить высоту строки
End With
Next
End Sub
Спасибо огромное! Теперь всё идеально!
Цитата: runner от 03.08.2018, 18:17
Теперь всё идеально!
позвольте усомниться ;)
в вашем коде надо выделять ячейки только в колонке с артикулами.
Не большое преобразование и можно оторваться от этой привязки...
В строки, которые попали в любое выделение ячеек(только не пытайтесь выделить целые столбцы, иначе надо будет еще преобразрвывать...), будут вставлены картинки в 3-м столбце;)
Если, конечно, сгенерированный из значений 1-й и 2-й ячейки путь к картинке существует.
Sub InsertPictures()
Dim c As Range
Dim Filename As String
on error resume next
For Each c In Selection.EntireRow
Filename = "R:\ФОТО\" & c.Cells(1).Value & "\150\" & c.Cells(2).Value & ".jpg"
With ActiveSheet.Shapes.AddPicture(Filename, _
msoFalse, msoTrue, c.Cells(3).Left, c.Cells(3).Top, 100, 100)
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную высоту
.ScaleWidth 1, msoTrue, msoScaleFromTopLeft 'вернуть исходную ширину
c.RowHeight = .Height + 10 'подстроить высоту строки
End With
Next
End Sub
У меня просто нет слов ..... этот модуль опередил мои следующие вопросы! :D :D :D
Всегда ставьте себе максимальные цели, а лишь потом корректируйте свои "аппетиты" встретившимися ограничениями, и то, не все ограничения являются таковыми!
Постановка "полуцелей" - ошибка большинства.