Данный макрос перебирает все строки на листе, и для каждой строки скачивает из интернета картинки, ссылки на которые присутствуют в этой строке (начиная с 3 столбца)
В процессе загрузки изображений из интернета отображается 2-уровневый прогресс-бар, на котором можно видеть текущее состояние процесса.
Если вам требуется вставлять много изображений на лист Excel, - то вам поможет надстройка, позволяющая производить поиск изображений в заданной папке, и производить вставку картинок в ячейки или примечания
Кроме того, надстройка для вставки изображений в Excel умеет загружать картинки из интернета (по ссылкам в таблице Excel)
При формировании имён файлов и путей к папкам применяется замена запрещённых символов на допустимые:
http://excelvba.ru/code/Replace_symbols
Для загрузки изображений применена WinAPI-функция URLDownloadToFile в таком виде:
Function DownLoadFile(FromPathName, ToPathName) As Boolean DownLoadFile = URLDownloadToFile(0, FromPathName, ToPathName, 0, 0) = 0 End Function
Папки с подпапками создаются тоже с использованием WinAPI: http://excelvba.ru/code/MkDir
Для обработки данных на листе использован такой макрос:
Sub ОсновнойМакрос() Dim sh As Worksheet, cell As Range, ra As Range: Application.ScreenUpdating = False Dim pi As New ProgressIndicator pi.Show "Загрузка фотографий" Set sh = ActiveSheet ' обрабатываем только активный лист ' For Each sh In ThisWorkbook.Worksheets ' перебираем все листы ' диапазон заполненных ячеек в столбце А, начиная с A2 Set ra = sh.Range(sh.[A2], sh.Range("A" & sh.Rows.Count).End(xlUp)) For Each cell In ra.Cells ' перебираем все ячейки диапазона ' формируем путь к новому файлу Путь = ThisWorkbook.Path & "\" & Replace_symbols(sh.Name) & _ "\" & Replace_symbols(cell) & "\" n = 100 / ra.Cells.Count: s1 = d * n + 1: s2 = (d + 1) * n: d = d + 1 pi.StartNewAction s1, s2, "Каталог: " & cell, "Загрузка фото с листа " & sh.Name CreateFolderWithSubfolders Путь ' создаём папку КолвоСсылок = cell.EntireRow.Cells(sh.Columns.Count).End(xlToLeft).Column - 2 If КолвоСсылок < 0 Then КолвоСсылок = 0 Dim pi2 As New ProgressIndicator: Set pi2 = pi.AddChildIndicator("Загрузка фото из строки") pi2.StartNewAction 5, 100, "Загрузка фото ...", , , КолвоСсылок ' перебираем все ссылки For i = 3 To cell.EntireRow.Cells(sh.Columns.Count).End(xlToLeft).Column pi2.SubAction , Путь, Replace_symbols(cell.Next) & "_" & (i - 2) & ".jpg" ИмяФайла = Путь & Replace_symbols(cell.Next) & "_" & (i - 2) & ".jpg" Ссылка = cell.EntireRow.Cells(i).Text ' Debug.Print ИмяФайла, Ссылка ' сохраняем очередную ссылку в виде файла в нужную папку If DownLoadFile(Ссылка, ИмяФайла) Then Debug.Print "Скачан файл: " & Ссылка Else MsgBox "Не удалось загрузить файл " & Ссылка, vbCritical End If Next i pi2.Hide Next cell ' Next sh ' перебираем все листы (переход к следующему листу) pi.Hide ' закрываем прогресс-бар End Sub
Смотрите также аналогичный (более простой) макрос загрузки изображений
Комментарии
я из xls файла, кликая на ссылку, скачиваю нужный файл автоматически. О какой авторизации в макросе идет речь? В вашем макросе?
Вы авторизованы в браузере, а не в макросе.
Я авторизован. При копировании ссылки на новую страницу браузера, рисунок открывается. Как правильно указать путь к файлу (ссылку) для скачивания?
Потому что ссылка эта ведёт не на картинку, а на скрипт, который ИНОГДА (если пользователь авторизован) может выдавать картинку.
Да, хорошо. Но, что не так в этой ссылке
https://forms.yandex.ru/u/files?path=%2F6662681%2F670e62d402848f444a83e0...
Почему скачивается вся страница вместо PNG файла?
Михаил, если что-то не получается, то мы можем написать макрос под заказ.
в формате doctype html
Добрый день.
Папки создает. Скачивает. После описанных изменений расширение файла не меняет.
НО, скачивает файл в . Ссылка формируется в файле .xls из YandexForm.
Игорь, а что делать если надо именно встроенным макросом скачать картинки, просто покупать программу для 1 документа не выгодно, а макрос который я попробовал работает(не спорю), но почему-то у меня перед тем как он скачает картинку я должен ее прокликать по ссылке, до прокликивания макрос почемуто не загружает ее. Я пытаюсь разобраться почему так но никак не могу понять.
Денис, нормально всё со ссылкой
Моя надстройка для скачивания / вставки картинок по ссылкам вполне справляется с подобными ссылками:
здравствуйте, макрос вроде работает но картинки не скачиваются просто пишет( не удалось загрузить файл и текст моей ссылки). у меня ссылка вроде обычная вот пример( http://p712691.ihc.xyz/GROSSMAN/Душевые системы/Душевая стойка Pragma 500.K35.03/500.K35.03.100 хром/500.K35.03.100 (4).jpg ) подскажите дело в ссылке или в чем - то другом?
ошибку выдаёт
Спасибо! Работает отлично! Важно правильно названия написать, не читает со знаками различными
Спасибо огромное! Как сделать что бы не останавливался при отсутствии файла, а переходил к следующей ссылке?
Доброго дня. Имеется прайс поставщика со ссылками на изображения на сайте и имеется накладная с закупкой от них, но уже без ссылок, как скачать только те изображения наименование которых содержится в нашей накладной
Спасибо большое за парсер. Подскажите пожалуйста, как сделать так что бы он не переименовывал картинки а просто сохранял так как есть на сайте?
Ниже в комментах есть ответ на ваш вопрос
Не работает под версией exel 10 64 bit версией как исправить не меняя систему
Здравствуйте. Кто подскажет как сделать.
Например имя картинки А-201 папка А-201. Если несколько картинок то картинки помещались бы в разные папки с названиями А-201_1, А-201_2, А-201_3 , а имя картинки оставалось А-201.
Очень нужная вещь! Большое человеческое спасибо!
Этот макрос не будет работать на 64-битной системе (он разрабатывался под 32-битный Office)
Используйте новую версию макроса, он работает на всех компьютерах.
Здравствуйте. Отличный макрос. Но стало выдавать ошибку. http://i-fotki.info/19/fdf367b53a5f26e820969bab65a3a00005ce5d228433797.j...
Помогите пожалуйста
Используйте более универсальный макрос
http://excelvba.ru/programmes/PastePictures
там есть поддержка кириллицы в ссылках, и намного больше опций
Очень крутой макрос!
Но ест вопрос, как сделать так, чтобы скачивались картинки у которых в ссылке присутствуют кириллические символы? А то выводится сообщение, что не удается скачать картинку.
Спасибо огромнейшее за макрос!!!! Не подскажете как оставить оригинальные имена файлов?
Папки всегда разные) т.е. вместо фото_1.jpg, фото_2.jpg, фото_3.jpg будет ссылка на ячейку с именем файла.
К примеру вместо
pi2.SubAction , Путь, Replace_symbols(cell.Next) & "_" & (i - 2) & ".jpg"
ИмяФайла = Путь & Replace_symbols(cell.Next) & "_" & (i - 2) & ".jpg"
будет (без учета перевода в макрос)
pi2.SubAction , Путь, CONCATENATE("J"; (i - 2))
ИмяФайла = Путь & CONCATENATE("J"; (i - 2))
где в ячейках J1 природа.jpg
J2 документ.doc
J3 фото.gif
К сожалению совсем не знаю язык, поэтому написал как в экселе))
Спасибо!
Григорий, я не совсем понял, как сохранить несколько файлов (ссылок ведь несколько в каждом столбце) под одним именем (из первой строки)...
Можем написать макрос под заказ, - обращайтесь.
Спасибо Огромное!!
Подскажите, как сохранить все файлы по ссылкам во всем столбце используя для этого имя в первой строке?
Например: Природа.jpg (под ним столбец с ссылками) , описание.doc (под ним столбец с ссылками) Спасибо)
оч круто! спасибо!
Спасибо, все отлично!
Доброй ночи.
Игорь, замените в коде ".jpg"
на
mid(cell.EntireRow.Cells(i).Text, instrrev(cell.EntireRow.Cells(i).Text, "."))да, расширение присутствует в ссылке, то есть последние 4-5 символов, типа .png или .jpeg
Игорь, а как узнать оригинальное расширение файла?
Если оно присутствует в ссылке на картинку, - то можно
(а если нет - то никак)
Отличный макрос, очень помог. Спасибо!
Есть вопрос, прошу по-возможности подсказать: Если мне необходимо сохранить оригинальное расширение скаченного файла, но с таким же принципом формирования имени:
pi2.SubAction , Путь, Replace_symbols(cell.Next) & "_" & (i - 2) & ".jpg"
ИмяФайла = Путь & Replace_symbols(cell.Next) & "_" & (i - 2) &
Что мне необходимо подставить вместо ".jpg" в двух строках?
Заранее спасибо!
Блин пацаны ВЫ СУПЕР!!!! Как я мучался и незнал как скачать кучу картинок. Офигеть как вы меня выручили. Спасибо Вам большое!!!!
Сергей,замените
на
Добрый день.
Подскажите пожалуйста, как получить ссылку, если она не написанная в ячейке, а стоит на нее.
Ребята, спасибо Вам большое! низкий поклон! макрос очень выручил!
Отправить комментарий