Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Автоматическая вставка картинки из папки по артикулу - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Автоматическая вставка картинки из папки по артикулу (Формулы/Formulas)
Автоматическая вставка картинки из папки по артикулу
TD_MElec Дата: Четверг, 18.07.2019, 12:44 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Формируется из программы файл «коммерческое предложение» . Имеется сетевая папка в которой лежат картинки с именем типа «Артикул.jpg» Необходимо вставить картинки в соответствующую ячейку (в примере столбец “B”). Количество срок, естественно, варьируется.
В поиске находил пример с колой и пепси, но там картинки подставляются уже вложенные, из файла, у меня же задача подобрать и вставить из внешнего источника, папки. Количество файлов картинок, постоянно обновляется. Сейчас их около 1 500 шт.
К сообщению приложен файл: 2749981.xls(28.0 Kb)
 
Ответить
СообщениеДобрый день.
Формируется из программы файл «коммерческое предложение» . Имеется сетевая папка в которой лежат картинки с именем типа «Артикул.jpg» Необходимо вставить картинки в соответствующую ячейку (в примере столбец “B”). Количество срок, естественно, варьируется.
В поиске находил пример с колой и пепси, но там картинки подставляются уже вложенные, из файла, у меня же задача подобрать и вставить из внешнего источника, папки. Количество файлов картинок, постоянно обновляется. Сейчас их около 1 500 шт.

Автор - TD_MElec
Дата добавления - 18.07.2019 в 12:44
TD_MElec Дата: Понедельник, 22.07.2019, 10:05 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Уважаемые эксперты, прошу сообщить, это возможно сделать?
 
Ответить
СообщениеУважаемые эксперты, прошу сообщить, это возможно сделать?

Автор - TD_MElec
Дата добавления - 22.07.2019 в 10:05
Pelena Дата: Вторник, 23.07.2019, 08:23 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 14874
Репутация: 3250 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Так хотели?
[vba]
Код
Public Sub InsPict()
    Dim arr, fldPath$, art$, fName$, i&, r0, lrow&, oDic As Object, IShape As Shape, Zm
    Set oDic = CreateObject("Scripting.Dictionary")
    r0 = 4
    lrow = Cells(Rows.Count, 3).End(xlUp).Row
    arr = Cells(r0, 3).Resize(lrow - r0 + 1).Value
    For i = 1 To UBound(arr)
        oDic(arr(i, 1)) = i + r0 - 1
    Next i
    For Each IShape In ActiveSheet.Shapes
        If IShape.Type <> 8 Then IShape.Delete
    Next
    fldPath = ThisWorkbook.Path & "\images\"    'путь к папке с изображениями
    Application.ScreenUpdating = False
    fName = Dir(fldPath & "*.jpg")
    Do While fName <> ""
        art = Split(fName, ".")(0)
        If oDic.Exists(art) Then
            With Cells(oDic(art), 2)
                Set IShape = ActiveSheet.Shapes.AddPicture(fldPath & fName, False, True, .Left + 1, .Top + 1, -1, -1)
                Zm = WorksheetFunction.Min(.Width / IShape.Width, .Height / IShape.Height)
                IShape.Height = IShape.Height * Zm - 2
            End With
        End If
        fName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: Img.rar(54.5 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеТак хотели?
[vba]
Код
Public Sub InsPict()
    Dim arr, fldPath$, art$, fName$, i&, r0, lrow&, oDic As Object, IShape As Shape, Zm
    Set oDic = CreateObject("Scripting.Dictionary")
    r0 = 4
    lrow = Cells(Rows.Count, 3).End(xlUp).Row
    arr = Cells(r0, 3).Resize(lrow - r0 + 1).Value
    For i = 1 To UBound(arr)
        oDic(arr(i, 1)) = i + r0 - 1
    Next i
    For Each IShape In ActiveSheet.Shapes
        If IShape.Type <> 8 Then IShape.Delete
    Next
    fldPath = ThisWorkbook.Path & "\images\"    'путь к папке с изображениями
    Application.ScreenUpdating = False
    fName = Dir(fldPath & "*.jpg")
    Do While fName <> ""
        art = Split(fName, ".")(0)
        If oDic.Exists(art) Then
            With Cells(oDic(art), 2)
                Set IShape = ActiveSheet.Shapes.AddPicture(fldPath & fName, False, True, .Left + 1, .Top + 1, -1, -1)
                Zm = WorksheetFunction.Min(.Width / IShape.Width, .Height / IShape.Height)
                IShape.Height = IShape.Height * Zm - 2
            End With
        End If
        fName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Pelena
Дата добавления - 23.07.2019 в 08:23
TD_MElec Дата: Вторник, 23.07.2019, 09:21 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Елена, спасибо.
Вы супер))
 
Ответить
СообщениеЕлена, спасибо.
Вы супер))

Автор - TD_MElec
Дата добавления - 23.07.2019 в 09:21
Spasibo_Vam_Ogromnoe Дата: Понедельник, 25.11.2019, 10:58 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день, в продолжение темы. А если в папки с картинками еще есть под папки, как сделать чтобы макрос и оттуда вставлял картинки, под папок много.
 
Ответить
СообщениеДобрый день, в продолжение темы. А если в папки с картинками еще есть под папки, как сделать чтобы макрос и оттуда вставлял картинки, под папок много.

Автор - Spasibo_Vam_Ogromnoe
Дата добавления - 25.11.2019 в 10:58
Pelena Дата: Понедельник, 25.11.2019, 12:30 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 14874
Репутация: 3250 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Без примера только общий ответ. Посмотрите здесь есть макрос, перебирающий файлы в подпапках.
Если не разберётесь, создайте свою тему, приложив файл с примером


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеБез примера только общий ответ. Посмотрите здесь есть макрос, перебирающий файлы в подпапках.
Если не разберётесь, создайте свою тему, приложив файл с примером

Автор - Pelena
Дата добавления - 25.11.2019 в 12:30
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Автоматическая вставка картинки из папки по артикулу (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!