Про вставку картинок (опять)

[Jockernsk]

День добрый всем. Начитался сейчас макросов от EducatedFool
... Оказывается автоматическое добавление ссылок на картинки из папок - это реальность.
Но у меня немного сложность в другом.
Во вложении пример куска рабочего файла с фотографиями.
Все работает все прекрасно, но для того чтобы отображались картинки, для начала я должен руками добавить ссылку на файл. Так вот как можно автоматизировать это добавление?
Есть несколько сложностей:
1.Имена файлов, как видно из примера, начинаются с нуля.
2.В них есть дефисы.
3. Бывают две картинки, которые я склеиваю в одну и файл получает длинное двойное название.
Листов обычно штук 10-12 и в них по 150-200 строк. Вот и сижу добавляю ссылки на картинки к каждой ячейке...весь день.


Если есть у кого вермя, и не составит труда...
Заранее, спасибо.

[EducatedFool]

Теперь описанный выше процесс будет занимать пару секунд: (смотрите пример в файле)
http://excelvba.ru/XL_Files/Sample__...__15-35-11.zip


Вот весь код:

Option Compare Text
Const СтолбецДляВставкиГиперссылок = 6

Sub ОсновнойМакрос()
    Dim sh As Worksheet: Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        ОбработатьЛист sh
        sh.Columns(СтолбецДляВставкиГиперссылок).AutoFit
    Next sh
End Sub

Sub ОбработатьЛист(ByRef sh As Worksheet)
    ПапкаСФотками = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Фото\")
    Dim cell As Range, ra As Range
    Set ra = sh.Range(sh.[A1], sh.Range("A" & sh.Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        МаскаФайла = ПапкаСФотками & sh.Name & "\" & cell & "*.jpg"
        ИмяНайденногоФайла = Dir(МаскаФайла)
        If Len(ИмяНайденногоФайла) > 0 Then    ' картинка найдена
            sh.Hyperlinks.Add cell.EntireRow.Cells(СтолбецДляВставкиГиперссылок), _
                              ПапкаСФотками & sh.Name & "\" & ИмяНайденногоФайла _
                            , , , Replace(ИмяНайденногоФайла, ".jpg", "")
        End If
    Next cell
End Sub

Внимание:
1) папка ФОТО должна находиться в той же папке, где и файл Excel с макросом.
2) Если всё будет работать правильно, измените значение константы СтолбецДляВставкиГиперссылок на 4
3) имя листа должно соответствовать имени подпапки, в которой расположена непосредственно сама картинка.


=============== добавлено позже ====================

У меня на сайте есть готовая программа для вставки изображений на лист Excel:
http://excelvba.ru/programmes/PastePictures

Надстройка позволяет искать в выбранной папке изображения, основываясь на содержимом ячеек таблицы Excel, и производить вставку найденных изображений в соседние ячейки (или в примечания к этим ячейкам).

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




Особенности надстройки вставки изображений:

• загрузка изображений по ссылкам (обычная гиперссылка, просто текст ссылки - URL, формула =ГИПЕРССЫЛКА(), и т.п.)
• поиск картинок в подпапках заданной папки (глубина поиска по подпапкам не ограничена)
• установка выбранного пользователем размера для вставляемых изображений
• отображение состояния поиска и вставки изображений (прогресс-бар)
• вывод результатов обработки таблицы (сколько изображений вставлено, сколько не найдено)
• добавление гиперссылок к вставляемым изображениям (по щелчку на картинке открывается исходный файл)
• 2 режима поиска файлов - по точному совпадению имени файла, и по началу имени файла-изображения
• 2 режима вставки картинок - подгонка размеров под ячейку, или соблюдение пропорций исходного изображения
• вывод количества файлов в выбранной папке
• возможность выбора столбца с названиями файлов, и указания номера столбца для вставляемых изображений
• возможность вставки изображений в комментарии к ячейкам

Запуск вставки изображений выполняется из меню программы (на панели инструментов)

Надстройка вставки картинок в Excel теперь поддерживает обновления - поэтому отныне надстройка будет регулярно получать новые полезные функции.

Новый функционал будет добавляться в надстройку по мере поступления ваших пожеланий.

[Jockernsk]

Не работает...

Ссылки вставляет, но если после вставки ссылок нажать на строку, то открывается не фотограФИЯ, а просто серое кошко, а фото в нем нету. Т.е. макрос, который отображает фото не срабатывает. Это первое.

А второе, как заставить вашу программу добавлять теже ссылки, туда же где слово "как 0-....."? В примере видно, что одна фотография используется на несколько позиций (строк).

[Jockernsk]

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

[EducatedFool]

Ссылки вставляет, но если после вставки ссылок нажать на строку, то открывается не фотограФИЯ, а просто серое кошко, а фото в нем нету

Проблема в том, что в гиперссылку прописывался абсолютный путь типа
C:\Documents and Settings\Admin\Рабочий стол\Фото\015\015-46-001 015-46TM.jpg
а нужен был относительный: Фото/015/015-46-001 015-46TM.jpg

Исправил, и переключил отображение на форме на гиперссылки из 6-го столбца:
http://excelvba.ru/XL_Files/Sample__...0__9-56-35.zip

PS: Странный у вас файл какой-то - текст гиперссылок по умолчанию отображается китайским шрифтом...

А второе, как заставить вашу программу добавлять теже ссылки, туда же где слово "как 0-....."

Это ВЫ мне должны были сказать, КАК заставить, - точнее, как объяснить программе, на какой из файлов ставить ссылку, если точного соответствия не найдено.
А я бы уже что-нибудь придумал.

Проанализировав предоставленные вами скудные исходные данные, я не смог понять принцип поиска другого файла.

К примеру:

015-7-001 901 шкатулка как 015-7-002
015-7-002 902 шкатулка 015-7-002
015-7-003 903 шкатулка как 015-7-002

Объясните, почему и для предыдущего, и для следующего, выбрана картинка с номером именно 015-7-002 ?
Если бы в последней строке 015-7-003 903 стояла ссылка на картинку с номером 015-7-004,
была бы хоть какая-то закономерность.

К примеру, будет отсутствовать картинка для 015-7-0015
И что делать макросу?
Подставлять картинку "как 015-7-016", или "как 015-7-014" ?

PS: Если вам лень сразу всё подробно описать (что и как должно работать) - то мне лень писать для вас несколько вариантов кода (чтобы вы выбрали подходящий)

[Jockernsk]

Не сердитесь, я и так понимаю, что вы мне делаете одолжение помогая в моих заботах, хотя уверен у вас есть занятия и поважнее. За это спасибо!
Далее по файлу. Наверное я просто плохо объяснил:
Мне отдельно сбрасывают екселевский файл и картинки к нему.
При открытии файла там уже прописаны имена картинок (как в пример 2), но ссылок на них нет. Я честно говоря понятия не имею по какому принципу тот человек, который мне присылает этот файл, расставляет имена файлов (картинок). Т.е. макрос, в моем представлении, должен сначала считывать, то что написано в ячейке (в данном случае в столбце 4), и смотреть пустая она или нет (т.к. могут просто ничего туда не вписать и не отправить мне картинку).
2. Если есть слово "как", то смотреть какое после слова идет имя файла, чтоб вставить такую же картинку.


Пример:
015-7-001 901 шкатулка как 015-7-002
015-7-002 902 шкатулка 015-7-002
015-7-003 903 шкатулка как 015-7-002


Вторая позиция данного примера прямо указывает на имя файла.
Первая и вторая то же шкатулка, но к примеру покрашена в другой цвет.
Артикул у нее уже меняется, а общая фотография - нет. Она все равно осталось шкатулкой, а не в мячик превратилась. Поэтому картинки чисто для визуальной проверки. Поэтому, для экономии места, на 1 и третью позицию добавляют эту же картинку, т.е. "шкатулку".
Про слово "как" я вам написал выше.

Вот такая замудреная система.
На китайский шрифт не обращайте внимания.

[EducatedFool]

Вы определитесь для начала, в какой папке искать фотографии.

Поначалу они были разбиты по подпапкам - например, ...\Фото\011\011-50-008.JPG
Теперь же, я так понял, все фотки в одной, корневой, папке: ...\Фото\011-50-001.JPG


Объяснение задачи теперь более понятное.
Переделаю макрос, когда ответите на вопрос по папкам (надо ли просматривать подпапки в каталоге ФОТО при поиске картинок).

PS: А зачем вообще гиперссылки? Может, не надо их?
Макрос отображения картинки на форме сможет найти её и без гиперссылки.
(если его немного переделать)

[Jockernsk]

Случайно забыл создать папку 011. Конечно подпапки будут (их примерно от 10 до 20-ти штук.).

Видите ли, люди уже несколько лет работали таким образом, т.е. со ссылками. Кому то удобней нажимать на них.
Опять же если картинка очень большая (всмысле размера), то ее лучше открывать в новом окне.

[makis555]

Добрый день форумчане!Помогите ночевку.
Вопрос: возможно ли создать на листе картинку при нажатии на которую открывается другой лист?

[EducatedFool]

Переделал все макросы.
Проверяйте: http://excelvba.ru/XL_Files/Sample__...__14-24-18.zip