Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.10.2016, 12:36   #1
wolf_den
Пользователь
 
Регистрация: 28.10.2011
Сообщений: 14
По умолчанию Вставить изображение в несколько файлов

Всем доброго времени суток. Есть 2000 фалов Excel, нужно в каждый из них на первый лист (в идеале еще бы и в заданную ячейку) вставить скан печати. Т.е. выбираем файл картинки, выбираем папку с Excel файлами, нажимаем кнопку - картинка вставляется в каждый из выбранных файлов.
Гугл не особо помог. Может хоть кто на мысль как реализовать натолкнет?
wolf_den вне форума Ответить с цитированием
Старый 28.10.2016, 13:27   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Макрос для вставки картинки а заданную ячейку / диапазон ячеек:
http://excelvba.ru/code/PastePictures

Осталось прикрутить цикл (10 строк кода), перебирающий все файлы в папке, открывающий каждый файл, вставляющий печать, и закрывающий файл с сохранением
EducatedFool вне форума Ответить с цитированием
Старый 28.10.2016, 13:27   #3
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

поможет макрос.
думаю, не более 10 строк
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 28.10.2016, 14:28   #4
wolf_den
Пользователь
 
Регистрация: 28.10.2011
Сообщений: 14
По умолчанию

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
Макрос для вставки картинки а заданную ячейку / диапазон ячеек:
http://excelvba.ru/code/PastePictures

Осталось прикрутить цикл (10 строк кода), перебирающий все файлы в папке, открывающий каждый файл, вставляющий печать, и закрывающий файл с сохранением
Да алгоритм понятен, просто с Visual Basic никогда не работал, поэтому как этот самый цикл и куда прикручивать - большой вопрос (

P.S. Ваш скрипт и надстройку видел
wolf_den вне форума Ответить с цитированием
Старый 28.10.2016, 15:09   #5
wolf_den
Пользователь
 
Регистрация: 28.10.2011
Сообщений: 14
По умолчанию

получается, что-то типа такого? Только в блок "Вставка значения" вставляем картинку, а не значение ячейки. Правильно?
Код:
Sub Vstavka()
    On Error Resume Next: Err.Clear
    ' запрашиваем пути к папкам с файлами
    InvoiceFolder$ = GetFolder(1, , "Выберите папку с файлами учебных планов")
    If InvoiceFolder$ = "" Then MsgBox "Не задана папка с планами", vbCritical, "Обработка планов невозможна": Exit Sub
 
    ArchieveFolder$ = GetFolder(2, , "Выберите папку, куда будут помещаться обработанные файлы планов")
    If ArchieveFolder$ = "" Then MsgBox "Не задана папка для архива планов", vbCritical, "Обработка планов невозможна": Exit Sub
 
    Dim coll As Collection
    ' загружаем список файлов по маске имени файла
    Set coll = FilenamesCollection(InvoiceFolder$, "*_up_*.xls*", 1)
 
    If coll.Count = 0 Then
        MsgBox "Не найдено ни одного плана для обработки в папке" & vbNewLine & InvoiceFolder$, _
               vbExclamation, "Нет необработанных планов"
        Exit Sub
    End If
 
    Dim pi As New ProgressIndicator: pi.Show "Обработка планов", , 2
    pi.StartNewAction , , , , , coll.Count    ' отображаем прогресс-бар

    Dim WB As Workbook, sh As Worksheet, ra As Range
    Application.ScreenUpdating = False  ' отключаем обновление экрана (чтобы процесс открытия файлов не был виден)

    ' перебираем все найденные в папке файлы
    For Each Filename In coll
 
        ' обновляем информацию на прогресс-баре
        pi.SubAction "Обрабатывается план $index из $count", "Файл плана: " & Dir(Filename), "$time"
        pi.Log "Файл: " & Dir(Filename)
 
        ' открываем очередной файл'
       Set WB = Nothing: Set WB = Workbooks.Open(Filename)
 
        If WB Is Nothing Then    ' не удалось открыть файл'
            pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."
 
        Else    ' файл успешно открыт
            Set sh = WB.Worksheets(1)    ' будем брать данные с первого листа
            ' берем диапазон ячеек с ячейки B1 до последней заполненной в столбце B
            Set ra = sh.Range(sh.Range("b1"), sh.Range("b" & sh.Rows.Count).End(xlUp))

'################### ВСТАВКА ЗНАЧЕНИЯ ######################'			
            ' ==== 
			sh.Range("a1")=10
			sh.Range("a1").interior.color = vbyellow
            ' ==== конец обработки данных из очередного файла

            WB.Close TRUE: DoEvents    ' закрываем обработанный файл c сохранением изменений
            pi.Log vbTab & "Файл успешно обработан."
 
            ' перемещаем обработанный файл из папки InvoiceFolder$ в папку ArchieveFolder$
            Name Filename As ArchieveFolder$ & Dir(Filename, vbNormal)
 
        End If
    Next
 
    ' закрываем прогресс-бар, включаем обновление экрана
    pi.Hide: DoEvents: Application.ScreenUpdating = True
    MsgBox "Обработка планов завершена", vbInformation
End Sub

Последний раз редактировалось wolf_den; 28.10.2016 в 15:36.
wolf_den вне форума Ответить с цитированием
Старый 28.10.2016, 15:46   #6
wolf_den
Пользователь
 
Регистрация: 28.10.2011
Сообщений: 14
По умолчанию

Макрос запускаться отказывается, ругается "sub or function not defined vba"
В Tools - References включил пункт Solver. Всё равно ошибка.
Код VBA вставлял в Module1. Пробовал объявить как Sub Module1.Vstavka(), тогда ошибка "Expected: end of statement"
wolf_den вне форума Ответить с цитированием
Старый 28.10.2016, 17:23   #7
wolf_den
Пользователь
 
Регистрация: 28.10.2011
Сообщений: 14
По умолчанию

Все решил. Взял
отсюда файл
Изменил его в соответствии
с этой темой (там же и ссылка на файл была)
Вставил картинку
Код:
Dim sha As Shape    
Set sha = ActiveSheet.Shapes.AddPicture("C:\pic.img", msoFalse, msoCTrue, -1, -1, -1, -1)
Изменил ее положение как надо
Код:
sha.left = [q12].left
sha.top = [q12].top
Доработал внешний вид под свои нужды и всё чудесно работает ))
wolf_den вне форума Ответить с цитированием
Старый 28.10.2016, 17:32   #8
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

в нормативные 10 строк вписались?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как вставить изображение из БД в Excel? Dux БД в Delphi 6 29.02.2016 11:15
Как вставить изображение на этом форуме? SASFM О форуме и сайтах клуба 6 28.10.2015 08:20
Как вставить изображение в таблицу MIKE11IPME БД в Delphi 2 22.04.2012 18:12
Вставить изображение в innertext Droid JavaScript, Ajax 5 12.10.2011 13:53
Как вставить изображение в RichEdit?? ver Помощь студентам 1 19.12.2009 21:52