Добрый день.
Для базы данных ищу решение такой задачи (из 2 пунктов):
1. Нужно вставить изображение по критерию (артикул). Расширение файлов изображений может быть любым.
Вариант решения тут:
Но здесь сначала нужно создать ссылки на изображения, затем по ним будет выполнен поиск. Ссылку на изображения я получаю с помощью формулы.
2. Нужно сделать масштабирование изображения, то есть нажимаем на маленькое изображение - оно увеличивается, нажимаем по увеличенному - оно возвращается к исходному размеру.
Найденный в интернете код работает частично, так как вставка изображений происходит по сути в ручном режиме - нужно выбирать ячейку и путь к файлу, чтобы сделать связку.
Можно ли как-то объединить коды, чтобы получить такой результат?
1. В колонке A список артикулов.
2. В колонку B автоматически вставляются изображения, найденные по артикулу в той же папке, где лежит файл Excel (в формате "иконок" под высоту ячейки, без каких-либо ссылок).
3. Иконки можно масштабировать до полного изображения и обратно.
Работаю в MS Excel 2016.
Для базы данных ищу решение такой задачи (из 2 пунктов):
1. Нужно вставить изображение по критерию (артикул). Расширение файлов изображений может быть любым.
Вариант решения тут:
Но здесь сначала нужно создать ссылки на изображения, затем по ним будет выполнен поиск. Ссылку на изображения я получаю с помощью формулы.
| Код |
|---|
=СЦЕПИТЬ(ПОДСТАВИТЬ(ЯЧЕЙКА("имяфайла");СЖПРОБЕЛЫ(ЛЕВСИМВ(ПРАВСИМВ(ПОДСТАВИТЬ(ЯЧЕЙКА("имяфайла");"\";ПОВТОР(" ";100));100);100));"");A1;".png") |
2. Нужно сделать масштабирование изображения, то есть нажимаем на маленькое изображение - оно увеличивается, нажимаем по увеличенному - оно возвращается к исходному размеру.
Найденный в интернете код работает частично, так как вставка изображений происходит по сути в ручном режиме - нужно выбирать ячейку и путь к файлу, чтобы сделать связку.
| Код |
|---|
Sub InsertImage()
Dim SHP As Shape, fName As String, Cel As Range
Set Cel = Application.InputBox("select cell for image placement & click on OK", "", , , , , , 8)
fName = Application.GetOpenFilename(Title:="Select image", FileFilter:="Images (*.gif;*.jpg;*.jpeg;*.bmp;*.png),*.gif;*.jpg;*.jpeg;*.bmp;*.png")
Cel.Select
ActiveSheet.Pictures.Insert(fName).Select
Set SHP = Selection.ShapeRange.Item(1)
Call PlaceImage(Cel, SHP)
SHP.OnAction = "ClickResizeImage" '(assign macro)
Cel.Select
End Sub
Sub PlaceImage(Cel As Range, SHP As Shape)
Dim W As Double, H As Double, L As Double, T As Double
Cel.Select: W = Cel.Width: H = Cel.Height: L = Cel.Left: T = Cel.Top
With SHP
.LockAspectRatio = msoTrue
.Width = W
If .Height > H Then .Height = H
.Left = L + (W - SHP.Width) / 2
.Top = T + (H - SHP.Height) / 2
End With
End Sub
Sub ClickResizeImage()
Dim SHP As Shape, Cel As Range, W As Double, H As Double, L As Double, T As Double
Set SHP = ActiveSheet.Shapes(Application.Caller)
Set Cel = SHP.TopLeftCell
Cel.Select: W = Cel.Width: H = Cel.Height: L = Cel.Left: T = Cel.Top
If SHP.Width < W Or SHP.Height < H Then SHP.Width = W * 5 Else Call PlaceImage(Cel, SHP)
End Sub
|
Можно ли как-то объединить коды, чтобы получить такой результат?
1. В колонке A список артикулов.
2. В колонку B автоматически вставляются изображения, найденные по артикулу в той же папке, где лежит файл Excel (в формате "иконок" под высоту ячейки, без каких-либо ссылок).
3. Иконки можно масштабировать до полного изображения и обратно.
Работаю в MS Excel 2016.
