|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
|
Опции темы | Поиск в этой теме |
16.10.2013, 17:14 | #1 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
Прошу помощи в соединении макросов Excel
Вот макрос указанный на обсуждаемой ранее теме по открытию нескольких книг в одной папке.
Sub Макрос1() ' скачан на "http://excelvba.ru/code/CombineFiles" On Error Resume Next: Err.Clear ' запрашиваем пути к папкам с файлами InvoiceFolder$ = GetFolder(1, , "Выберите папку с файлами заявок (из Outlook)") 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$, "Заявка №*от*.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, False, True) If WB Is Nothing Then ' не удалось открыть файл pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан." Else ' файл успешно открыт Set sh = WB.Worksheets(1) ' будем работать с первым листом ' удаляем первые 2 столбца sh.range("a:b").entirecolumn.delete WB.Close TRUE: DoEvents ' закрываем обработанный файл с сохранением изменений pi.Log vbTab & "Файл успешно обработан." End If Next ' закрываем прогресс-бар, включаем обновление экрана pi.Hide: DoEvents: Application.ScreenUpdating = True MsgBox "Обработка заявок завершена", vbInformation End Sub Последний раз редактировалось Alexsandrr; 16.10.2013 в 17:19. |
16.10.2013, 17:18 | #2 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
У меня в папке "V:\Отдел планирования закупок\2013\ЗАПАСЫ\Форум\Заявочная " находятся книги (7_10_Заявка ФПК_КРАС_01кв, 22_5_Заявка ФПК_ПРИВ_03кв, ....,....). Данных книг порядка 60 шт, которые обрабатываются вот этим макросом2 (прикреплен в папке)
Мне нужно Макрос2 соединить с Макрос1, чтобы Макрос1 обеспечил открытие каждой книги по очереди, а Макрос2 каждую открытую книгу обработал. |
16.10.2013, 20:45 | #3 |
Форумчанин
Регистрация: 25.03.2010
Сообщений: 417
|
вот это:
Код:
Код:
Код:
Код:
|
17.10.2013, 09:54 | #4 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
В объединении макросов, в строке "InvoiceFolder$ = GetFolder(1, , "Выберите папку с файлами заявок (из Outlook)")" выдает ошибку "Sub or Function not defined-Подпрограмма или функция не определена" и выделяет данное слово "GetFolder":
Не могли бы посмотреть сам макрос? Последний раз редактировалось Alexsandrr; 17.10.2013 в 10:00. |
17.10.2013, 09:56 | #5 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
вот файл, забыл вставить
|
17.10.2013, 12:10 | #6 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
Может быть данные Функции VBA для получения списка файлов из папки,
с учётом выбранной глубины поиска в подпапках нужны, чтобы макрос работал? Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _ Optional ByVal SearchDeep As Long = 999) As Collection ' Получает в качестве параметра путь к папке FolderPath, ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением) ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются). ' Возвращает коллекцию, содержащую полные пути найденных файлов ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO) Set FilenamesCollection = New Collection ' создаём пустую коллекцию Set FSO = CreateObject("Scripting.FileSystemO bject") ' создаём экземпляр FileSystemObject GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск Set FSO = Nothing: Application.StatusBar = False ' очистка строки состояния Excel End Function Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _ ByRef FileNamesColl As Collection, ByVal SearchDeep As Long) ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO ' перебор папок осуществляется в том случае, если SearchDeep > 1 ' добавляет пути найденных файлов в коллекцию FileNamesColl On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath) If Not curfold Is Nothing Then ' если удалось получить доступ к папке ' раскомментируйте эту строку для вывода пути к просматриваемой ' в текущий момент папке в строку состояния Excel ' Application.StatusBar = "Поиск в папке: " & FolderPath For Each fil In curfold.Files ' перебираем все файлы в папке FolderPath If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path Next SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках If SearchDeep Then ' если надо искать глубже For Each sfol In curfold.SubFolders ' перебираем все подпапки в папке FolderPath GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep Next End If Set fil = Nothing: Set curfold = Nothing ' очищаем переменные End If End Function |
17.10.2013, 14:32 | #7 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
Никто не подскажет?
|
17.10.2013, 20:08 | #8 |
Форумчанин
Регистрация: 25.03.2010
Сообщений: 417
|
Поверьте, это не единственная ошибка, которую выдаст. там их будет куча
|
17.10.2013, 21:42 | #9 |
Форумчанин
Регистрация: 25.03.2010
Сообщений: 417
|
как то так
|
18.10.2013, 09:16 | #10 |
Пользователь
Регистрация: 02.10.2013
Сообщений: 78
|
Вот спасибо!!!!!!!!
Только можно еще вопрос? Путь я поправил к папке, только не видит мои файла Excel. Я понимаю в этой строке проблема: Dim coll As Collection ' загружаем список файлов по маске имени файла Set coll = FilenamesCollection(InvoiceFolder$, "Заявка №*от*.xls*") Файлы у меня называются к примеру "7_10_Заявка ФПК_КРАС_01кв", "1_08_Заявка ФПК_ПРИВ_04кв". Неизменные части :"Заявки", "ФПК", "кв". Или вообще просто сделать чтобы видел все книги Excel, а я мог выбрать любые. Большое спасибо за оказанное содействие! |
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Прошу помощи:) | valiza | Помощь студентам | 0 | 03.07.2009 11:58 |
Excel в xml, прошу помощи | CaH4oo | Microsoft Office Excel | 4 | 20.12.2008 09:31 |
Прошу помощи! | Oksana | Общие вопросы Delphi | 6 | 11.02.2007 18:36 |