Выбрать и вставить картинку в Excel

[velis83]

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

[AleksandraRobota]

Это просто грустно...сперва так понравился макрос, который вставляет картинки по именам, а потом после его работы узнаю что вместо картинки с именем 1 (как в списке названий картинок) он тупо выбирает из папки картинку с именем 169. почему не находит точного соответствия??

[EducatedFool]

почему не находит точного соответствия?

Так задумано) но это несложно исправить.

Найдите в макросе строку
FilePath = Dir(ПутьКПапкеСКартинками & cell & "*")
Именно эта строка отвечает за поиск файла по маске имени.

Замените её на это
FilePath = Dir(ПутьКПапкеСКартинками & cell & ".jpg")
тогда для ячейки 123 будет искаться только файл 123.jpg

Если замените её на это
FilePath = Dir(ПутьКПапкеСКартинками & cell & ".*")
тогда для ячейки 123 будет искаться файл с названием 123 (файл 12345 не будет найден) с любым расширением - 123.jpg, 123.bmp и т.д.

[AleksandraRobota]

Ура, спасибо! Отлично работает

[AleksandraRobota]

подскажите, а возможно ли сделать так чтобы когда ставится фильтр на названия фотографий, можно было вставлять фото только по этому отфильтрованному списку.
у меня фотоотчет по сети супермаркетов по Украине. Когда выбираю магазины какого то региона чтобы только их анализировать, к сожалению показывает фото и всех скрытых регионов

[EducatedFool]

подскажите, а возможно ли сделать так чтобы когда ставится фильтр на названия фотографий

возможно.
вообще всё возможно - если при формулировке задачи не экономить слова...

в вашем случае - с фильтрами - я ничем вам помочь не могу.
поскольку в исходной задаче про фильтр не было ни слова,
а что вы там фильтруете в своём файле, я представления не имею.

[AleksandraRobota]

Оказалось вставлять фото только по видимым ячейкам (после фильтрации) очень легко. Кому пригодится это делается так

Dim Cell As Range, ra As Range: Application.ScreenUpdating = False
Dim c As Long
c = 10 'Номер столбца в котором записаны имена фотографий
Set ra = Range(Cells(1, c), Cells(Rows.Count, c).End(xlUp)).SpecialCells(xlCellTy peVisible)

[AleksandraRobota]

не пойму из-за чего глюк происходит: когда вставляю макросом более 100 фотографий (всего у меня по списку 420 супермаркетов, без фильтра), то где-то на 25 фотка начинает смещение от границ ячейки, помаленьку фотки ползут вверх. и в конце они уже где-то на половину только в ячейке, а наполовину вылезшие. И это выглядит отвратительно...

[EducatedFool]

не пойму из-за чего глюк происходит

из-за Excel2007
Если бы вы использовали Excel2003 - такой проблемы бы не было.

Как избавиться от проблемы в Excel2007 - не знаю
(там положение картинки зависит от того, отображаются ли границы ячеек)

Делал так - в некоторых случаях помогает:

Function ВставитьКартинку(ByRef cell As Range, ByVal pic As String) As Picture
    ' если картинка вставлена успешно, возвращает TRUE
    On Error Resume Next: Err.Clear
    Dim ph As Picture: Set ph = cell.Parent.Pictures.Insert(pic)
    Set ВставитьКартинку = ph
    ph.Placement = xlMoveAndSize
    ph.ShapeRange.LockAspectRatio = msoFalse
    ph.Top = cell.Top - CLng(Val(Application.Version) = 12) * 0.1 * cell.Row
    ph.Left = cell.Left
    '    k = ph.Width / ph.Height
    '    ph.Width = cell.Width: ph.Height = ph.Width / k
    ph.Width = cell.Width: ph.Height = cell.Height

    'cell.EntireRow.RowHeight = ph.Height
    'If (Val(Application.Version) = 12) Then cell.Borders.LineStyle = xlNone
End Function

PS: Если кто знает, как решить эту проблему в Excel2007 и более поздних версиях (чтобы картинки вставлялись без сдвига) - подскажите, пожалуйста.

[AleksandraRobota]

как можно сделать чтобы выделять диапазон в столбце и на эту высоту вставлялось фото?