Функция предназначена для сохранения двумерного массива в файл формата XLS
Sub SaveArray(ByVal Arr, ByVal ColumnNames, ByVal DocName$) ' Получает двумерный массив Arr с данными, и массив заголовков столбцов ColumnNames. ' Создаёт новый файл в подпапке СФОРМИРОВАННЫЕ ДОКУМЕНТЫ с именем DocName$ On Error Resume Next ' создаём подпапку (там же, где текущий файл Excel) folder$ = ThisWorkbook.Path & "\СФОРМИРОВАННЫЕ ДОКУМЕНТЫ\": MkDir folder$ Application.ScreenUpdating = False Dim sh As Worksheet, wb As Workbook Set wb = Application.Workbooks.Add(xlWBATWorksheet) ' создаём новый файл Excel Set sh = wb.Worksheets(1): sh.Name = DocName$ ColumnsNamesCount = UBound(ColumnNames) - LBound(ColumnNames) + 1 With sh.Range("a1").Resize(, ColumnsNamesCount) ' выводим заголовки столбцов .Value = ColumnNames .Interior.ColorIndex = 15: .Font.Bold = True With sh.Range("a2").Resize(UBound(Arr, 1), UBound(Arr, 2)) ' и данные .Value = Arr .Borders.LineStyle = xlContinuous End With .EntireColumn.AutoFit End With ' сохраняем и закрываем созданный файл Excel Filename$ = folder$ & DocName$ & " " & Format(Now, "dd-mm-yyyy hh-nn-ss") & ".xls" wb.SaveAs Filename$, xlWorkbookNormal ' формат XLS wb.Close False ' показываем созданный файл в папке CreateObject("WScript.Shell").Run "explorer.exe /e,/select,""" & Filename$ & """" Application.ScreenUpdating = True End Sub
Пример использования:
Sub test_SaveArray() Arr = Range("a2:f20").Value Headers = Array("Штрихкод", "Наименование", "Кол-во", "Артикул", "Цена", "Поставщик") SaveArray Arr, Headers, "Склад" ' создаём из массива Arr файл Excel с именем СКЛАД End Sub
Комментарии
Отправить комментарий