Экспорт в Excel

[sergey-911]

Всем доброго времени суток уважаемые. Всех с Днем молодежи.
http://bbs.vbstreets.ru/viewtopic.php?t=22905 - здесь разбиралась тема, как сделать импорт данных из Excel.
Сейчас проблема обратная. Нужно данные из динамического набора

Код: Выделить всё

Dim rs As ADODB.Recordset

в виде таблицы поместить в файл экселя, сделав необходимый заголовок и открыть програмно, чтобы пользователь смог распечатать или подредактировать. Ширина колонок таблиц должна задаваться мной, границы таблицы должны быть прорисованы.

[Twister]

Создается массив типа Variant и пишется "одним махом" в Excel. Про то, как программно изменить ширину ячеек, можешь посмотреть, нажав "Макрос -> Начать запись"...

[BasiС]

Делаешь новую книгу а затем:

Код: Выделить всё

'Создание заголовков
For i = 0 To rs.Fields.Count - 1: Cells(1, i + 1).Value = rs.Fields(i).Name: Next i
'Вставка рекордсета в новый лист
ActiveSheet.Range("A2").CopyFromRecordset rs
rs.Close

Ну а с шириной колонок, цветом и др разберёшся?

[sergey-911]

Twister
Не смог понять, как массив типа Variant и пишется "одним махом" в Excel.
Пытался в циклах реализовать заполнение файла Excel - работает ужасно долго.

[sergey-911]

BasiС
Завтра на работе попытаюсь разобраться, не факт, что у меня получится.

[sergey-911]

BasiС

Код: Выделить всё

Private Sub mnuSaveRepXLS_Click()
On Error GoTo Er
   
    Dim Cols As TrueOleDBGrid80.Columns
    Set Cols = TDBGrid1.Columns
    Dim i, c As Byte
    Dim xla As New Excel.Application
    Dim xlb As New Excel.Workbook
    Dim xls As New Excel.Worksheet
    Dim xlr As Excel.Range
   
    MousePointer = vbHourglass
    Set xlb = xla.Workbooks.Add
    Set xls = xlb.Worksheets.Add
    xls.Activate
    For i = 0 To Cols.Count - 1
        c = i + 1
        'Задаем имя столбца
        xls.Cells(1, c) = Cols.Item(i).DataField
        Set xlr = xls.Cells(1, c)
        'Выделяем верхнюю строку полужирным шрифтом
        xlr.Select
        xlr.Font.Bold = True
    Next i
    'Позицируем курсор на листе для вставки в нужное место
    Set xlr = xls.Cells(1, 1)
    'Для вставки всего динамического набора
    TData1.Recordset.MoveFirst
    'Вставка рекордсета в лист
    xlr.Range("A2").CopyFromRecordset TData1.Recordset
    TData1.Recordset.MoveFirst
    MousePointer = vbDefault
    'Диалог сохранения в файл
    CommonDialog1.DefaultExt = "xls"
    CommonDialog1.Filter = "Excel (*.xls)|*.xls"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowSave
    If Len(CommonDialog1.FileName) = 0 Then
        Exit Sub
    End If
    'Сохранение в файл
    MousePointer = vbHourglass
    xls.SaveAs (CommonDialog1.FileName)
    xlb.Saved = True
    xla.Quit
    MousePointer = vbDefault

Exit Sub
Er:
MousePointer = vbDefault
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error"
End Sub


Процедура сохранения в файл Excel (если я все правильно понял) - работает.

[sergey-911]

Теперь безрезультатно пытаюсь сделать границы таблицы в документе и отформатировать вставленные ячейки, чтобы в случае непомещения текста в ячейку срабатывал перенос, а сама ячейка увеличивалась по вертикали (если возможно). А также не получается задать ширину колонки в таблице.

[BasiС]

Всё вышеперечисленое возможною
Воспользуйся записью макроса в Excel, проанализируй то, что получится и преобразуй в код vb

[sergey-911]

Спасибо - попробую.