Доброе время суток, господа! Хотелось бы попросить помощи вот в каком вопросе: Есть "выгрузка" в excel из сторонней бызы данных на foxpro, выгрузка кривая, реализованная через кучу костылей, имя выгрузки каждый раз новое, база присваивает его исходя из даты, фазы луны, календаря майя и тд. В этом же каталоге есть Модуль.exlsm, в котором идут расчеты на основании этой выгрузки, перенос данных из выгрузки в модуль я реализовал через ВПР()*1, так как в выгрузке, числа почему-то определяются как текст. Пока я работал с расчетами, то имя новой выгрузки менял вручную, но сейчас я увольняюсь, на мое место придет другой человек, который не очень хорошо знаком с excel, и что бы автоматизировать процесс я увидел 2 варианта: 1. Подготовить макрос который сам будет переносить данные, в принципе реализовать не сложно: [vba]
Код
Sub () ...... Range("D7:S1008").Select 'диапазон из выгрузки' Selection.Copy Range("D7").Select ActiveSheet.Paste
End Sub
[/vba] но я не знаю как обратиться к "выгрузке", которая располагается в том же каталоге, и как присвоить формат ячеек "числовой"
2. Подготовить макрос, который будет по нажатию кнопки переименовывать "выгрузку" в заданное имя Тут я вообще не знаю что делать. Буду благодарен за любую помощь.
Доброе время суток, господа! Хотелось бы попросить помощи вот в каком вопросе: Есть "выгрузка" в excel из сторонней бызы данных на foxpro, выгрузка кривая, реализованная через кучу костылей, имя выгрузки каждый раз новое, база присваивает его исходя из даты, фазы луны, календаря майя и тд. В этом же каталоге есть Модуль.exlsm, в котором идут расчеты на основании этой выгрузки, перенос данных из выгрузки в модуль я реализовал через ВПР()*1, так как в выгрузке, числа почему-то определяются как текст. Пока я работал с расчетами, то имя новой выгрузки менял вручную, но сейчас я увольняюсь, на мое место придет другой человек, который не очень хорошо знаком с excel, и что бы автоматизировать процесс я увидел 2 варианта: 1. Подготовить макрос который сам будет переносить данные, в принципе реализовать не сложно: [vba]
Код
Sub () ...... Range("D7:S1008").Select 'диапазон из выгрузки' Selection.Copy Range("D7").Select ActiveSheet.Paste
End Sub
[/vba] но я не знаю как обратиться к "выгрузке", которая располагается в том же каталоге, и как присвоить формат ячеек "числовой"
2. Подготовить макрос, который будет по нажатию кнопки переименовывать "выгрузку" в заданное имя Тут я вообще не знаю что делать. Буду благодарен за любую помощь.hathory
hathory
Сообщение отредактировал hathory - Четверг, 26.01.2017, 13:40
если по теме, работа с файлами из каталога (функции не мои, нашел в инете): [vba]
Код
Dim t As Integer, k As Integer, str As String, tek As Integer, rWB As Workbook, rSh As String, numsRow As Collection, f As Integer Rpath = InputBox("где лежат файлы *.xls", "Укажите путь!", ActiveWorkbook.Path & "\01") Texcel = ActiveWorkbook.Name rSh = ActiveSheet.Name tek = Workbooks(Texcel).Sheets(rSh).Cells(1, 17).Value Set DirFile = FilenamesCollection(Rpath, "*.xls", 1) ' составим список файлов для исходных данных If DirFile.Count < 1 Then MsgBox "в указаной папке отсутсвуют файлы *.xls", vbCritical, "Ошибка!!!": Exit Sub For k = 1 To DirFile.Count Set rWB = Workbooks.Open(DirFile(k)) ' открываем файлы по порядку next k end sub
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.FileSystemObject") ' создаём экземпляр 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
[/vba]
hathory, чтобы халява врагу не досталась :-)
если по теме, работа с файлами из каталога (функции не мои, нашел в инете): [vba]
Код
Dim t As Integer, k As Integer, str As String, tek As Integer, rWB As Workbook, rSh As String, numsRow As Collection, f As Integer Rpath = InputBox("где лежат файлы *.xls", "Укажите путь!", ActiveWorkbook.Path & "\01") Texcel = ActiveWorkbook.Name rSh = ActiveSheet.Name tek = Workbooks(Texcel).Sheets(rSh).Cells(1, 17).Value Set DirFile = FilenamesCollection(Rpath, "*.xls", 1) ' составим список файлов для исходных данных If DirFile.Count < 1 Then MsgBox "в указаной папке отсутсвуют файлы *.xls", vbCritical, "Ошибка!!!": Exit Sub For k = 1 To DirFile.Count Set rWB = Workbooks.Open(DirFile(k)) ' открываем файлы по порядку next k end sub
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.FileSystemObject") ' создаём экземпляр 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
K-SerJC, спасибо, но Rpath не подойдет, каталог будут, скорее всего, перемещать, нужно что бы поиск велся в том каталоге где лежит Модуль, и не бился полный путь...
K-SerJC, спасибо, но Rpath не подойдет, каталог будут, скорее всего, перемещать, нужно что бы поиск велся в том каталоге где лежит Модуль, и не бился полный путь...hathory
hathory
Сообщение отредактировал hathory - Четверг, 26.01.2017, 14:14
K-SerJC, спасибо, но Rpath не подойдет, каталог будут, скорее всего, перемещать, нужно что бы поиск велся в том каталоге где лежит Модуль, и не бился полный путь...
K-SerJC, спасибо, но Rpath не подойдет, каталог будут, скорее всего, перемещать, нужно что бы поиск велся в том каталоге где лежит Модуль, и не бился полный путь...