Option Explicit
Sub Main()
Application.ScreenUpdating = False
Dim arr As Variant
arr = ShowFileDialog()
Dim brr As Variant
Dim orr As Variant
ReDim orr(1 To UBound(arr, 1) + 1, 1 To 8)
orr(1, 1) = "Файлы"
orr(1, 2) = "ИНН"
orr(1, 3) = "рейтинг 1"
orr(1, 4) = "рейтинг 2"
orr(1, 5) = "рейтинг 3"
orr(1, 6) = "расчет 1"
orr(1, 7) = "расчет 2"
orr(1, 8) = "расчет 3"
If Not IsEmpty(arr) Then
Dim wb As Workbook
Dim v As Variant
Dim y As Long
y = 1
For Each v In arr
Application.StatusBar = Right(v, 255)
Set wb = Workbooks.Open(v, False, True)
With wb.Sheets(1)
brr = .Range(.Cells(1, 1), .Range("I76"))
End With
y = y + 1
orr(y, 1) = wb.Name
wb.Close
orr(y, 2) = brr(7, 5) 'E7
orr(y, 3) = brr(61, 7) 'G61
orr(y, 4) = brr(61, 7) 'G61
orr(y, 5) = brr(61, 9) 'I61
orr(y, 6) = brr(76, 7) 'G76
orr(y, 7) = brr(76, 7) 'G76
orr(y, 8) = brr(76, 9) 'I76
Application.StatusBar = False
Next
Workbooks.Add(1).Sheets(1).Cells(1, 1).Resize(UBound(orr, 1), UBound(orr, 2)) = orr
End If
Application.ScreenUpdating = True
End Sub
Function ShowFileDialog() As Variant
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "Выбрать файлы отчетов" 'заголовок окна диалога
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
' .Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = ThisWorkbook.Path 'назначаем папку отображения и имя файла по умолчанию
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If oFD.Show = 0 Then Exit Function 'показывает диалог
'цикл по коллекции выбранных в диалоге файлов
Dim arr As Variant
ReDim arr(1 To .SelectedItems.Count)
For lf = 1 To .SelectedItems.Count
arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу
'Workbooks.Open x 'открытие книги
'можно также без х
'Workbooks.Open .SelectedItems(lf)
Next
ShowFileDialog = arr
End With
End Function
|