> lobook = m.loExcel.workbooks.open('c:\f.xls')


Ну после открытия его не плохо было бы скопировать в новую книгу, а потом
сразу закрыть.

У меня отчет не только переменной высоты, но и переменной ширины.
Чисто фоксовые комманды можешь сильно не разбирать, т.к. они завязаны на МОЮ
таблицу, а вот приемы работы с excel`ем - можешь подсмотрерь.


WAIT WINDOW 'Идет сброс информации по оплатам в EXCEL' NOWAIT NOCLEAR

&& Выброс данных в Excel

LOCAL goExcel

goExcel = CREATEOBJECT("Excel.Application")

if vartype(goExcel) # "O"

MessageBox("Excel не найден!!!",0,'Внимание!!!')

RETURN .f.

endif

goExcel.DisplayAlerts = .F.

LOCAL lcShablon, lcNameShablon, lcNameOut

&& Открывем файл шаблона

lcShablon='.\Шаблоны\Реестр_Оплат.xls'

if !file(lcShablon)

MessageBox('Не найден файл шаблона. Отчет не будет
оформлен!!!'+chr(13)+'Чтобы избежать этой ситуации в будущем создайте файл
"'+lcShablon+'" и оформите шапку отчета',0,'Внимание!!!')

loShablon=goExcel.WorkBooks.Add()

ELSE

lcShablon=FULLPATH(lcShablon)

loShablon=goExcel.WorkBooks.Open(lcShablon)

endif

&& Копируем первую страницу шаблона в новый документ

loNewDoc=goExcel.WorkBooks.add

loShablon.Sheets(1).Copy(loNewDoc.Sheets(1))

loShablon.Close

&& Удаляем остальные листы нового документа

for i=loNewDoc.Sheets.Count to 2 step -1

loNewDoc.Sheets(i).delete

EndFor



&& Собственно заполнение листа Excel из курсора

SELECT Full_oplat

LOCAL lnOldKod, lnColumn, lnRow, ldLastDate

lnOldKod=0

lnColumn=0

#DEFINE lnStartRow 7

ldLastDate=ldDateBegin

&& Записываем данные в колонки

SCAN all

IF lnOldKod#Full_oplat.kod

lnOldKod=Full_oplat.kod

lnColumn=lnColumn+1

lnRow=lnStartRow-2

loNewDoc.Sheets(1).cells(lnRow, lnColumn+1).value=RTRIM(Full_oplat.Naimen)

* loNewDoc.Sheets(1).cells(lnRow, lnColumn+1).Font.Bold = .T.

lnRow=lnRow+1

loNewDoc.Sheets(1).cells(lnRow, lnColumn+1).value=Full_oplat.kod

lnRow=lnRow+1

ENDIF

IF lnColumn=1

loNewDoc.Sheets(1).cells(lnRow, 1).value=DTOC(Full_oplat.Dates)

ENDIF

loNewDoc.Sheets(1).cells(lnRow, lnColumn+1).value=NVL(Full_oplat.Summa,0)

lnRow=lnRow+1

ENDSCAN

lnColumn=lnColumn+1

loNewDoc.Sheets(1).cells(lnStartRow-2, lnColumn+1).VALUE = "ИТОГО по дням"

FOR lnRowI=lnStartRow TO lnRow

&& Прописываем формулу сумма в конец строк

loNewDoc.Sheets(1).cells(lnRowI, lnColumn+1).Select()

loNewDoc.Sheets(1).cells(lnRowI, lnColumn+1).FormulaR1C1 =
"=SUM(RC[-"+TRANSFORM(lnColumn-1)+"]:RC[-1])"



*!* IF loNewDoc.Sheets(1).cells(lnRowI, lnColumn+1).Value = 0 && Если сумма
в колонке равна 0 - скрываем колонку

*!* loNewDoc.Sheets(1).Rows(lnRowI).EntireRow.Hidden = .t.

*!* ENDIF

ENDFOR

&& Прописываем форматы ячеек

loNewDoc.Sheets(1).range(loNewDoc.Sheets(1).cells(lnStartRow, 2),
loNewDoc.Sheets(1).cells(lnRow, lnColumn+1)).NumberFormat = "#,##0.00"

&& Ширина последней строки (увеличиваем) и делаем жирный шрифт

loNewDoc.Sheets(1).Rows(lnRow).RowHeight = 22.5

loNewDoc.Sheets(1).Range(loNewDoc.Sheets(1).Rows(lnRow),loNewDoc.Sheets(1).Rows(lnRow+2)).Font.Bold
= .T.

loNewDoc.Sheets(1).cells(lnRow, 1).Value = "ИТОГО"

loNewDoc.Sheets(1).cells(lnRow+1, 1).Value =
"Сумма"+CHR(10)+"вознаграждения"

loNewDoc.Sheets(1).cells(lnRow+2, 1).Value = "Сумма
к"+CHR(10)+"перечислению"

FOR lnColumnI=2 TO lnColumn

&& Прописываем формулу сумма в конец колонок

loNewDoc.Sheets(1).cells(lnRow, lnColumnI).Select()

loNewDoc.Sheets(1).cells(lnRow, lnColumnI).FormulaR1C1 =
"=SUM(R[-"+TRANSFORM(lnRow-lnStartRow)+"]C:R[-1]C)"



IF loNewDoc.Sheets(1).cells(lnRow, lnColumnI).Value = 0 && Если сумма в
колонке равна 0 - скрываем колонку

loNewDoc.Sheets(1).Columns(lnColumnI).EntireColumn.Hidden = .t.

ELSE && Иначе подобрать ширину колонки по ее содержимому

loNewDoc.Sheets(1).Columns(lnColumnI).EntireColumn.AutoFit

ENDIF

ENDFOR

loNewDoc.Sheets(1).Columns(lnColumn+1).EntireColumn.AutoFit

&& После подбора ширины колонки добавляем "ДЛИННЫЙ" текст в шапку отчета

loNewDoc.Sheets(1).cells(2, 1).Value = "Реестр оплат населения по
"+vid_sekt+" за период с "+DTOC(ldDateBegin)+" по "+DTOC(ldDateEnd)



loNewDoc.Sheets(1).cells(lnRow+2, 1).Value = "Данные подготовил
"+app_vs.GetkodOper()



&& Добавляем рамку на шапку

with loNewDoc.Sheets(1).Range(loNewDoc.Sheets(1).cells(lnStartRow-2, 1),
loNewDoc.Sheets(1).cells(lnStartRow, lnColumn+1))

with .Borders(7) &&xlEdgeLeft

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith


with .Borders(8) &&xlEdgeTop

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith


with .Borders(9) &&xlEdgeBottom

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith

with .Borders(10) &&xlEdgeRight

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith


with .Borders(11) &&xlInsideVertical

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith

with .Borders(12)&&xlInsideHorizontal

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith

EndWith



&& Добавляем рамку на данные

with loNewDoc.Sheets(1).Range(loNewDoc.Sheets(1).cells(lnStartRow, 1),
loNewDoc.Sheets(1).cells(lnRow, lnColumn+1))

with .Borders(7) &&xlEdgeLeft

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith


with .Borders(8) &&xlEdgeTop

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith


with .Borders(9) &&xlEdgeBottom

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith

with .Borders(10) &&xlEdgeRight

..LineStyle=1

..Weight = 2

..ColorIndex = -4105

EndWith


with .Borders(11) &&xlInsideVertical

..LineStyle=1

..Weight = 1

..ColorIndex = -4105

EndWith

with .Borders(12)&&xlInsideHorizontal

..LineStyle=1

..Weight = 1

..ColorIndex = -4105

EndWith

EndWith



*loNewDoc.ErrorCheckingOptions.NumberAsText = .F.

*loNewDoc.Save

wait clear

loNewDoc.Sheets(1).Activate

goExcel.DisplayAlerts = .T.

goExcel.Visible = .T.

release goExcel


Posted via ActualForum NNTP Server 1.4

Да, через nntp некрасиво вставка получилась.... :)

А вот тебе другой кусок, который отработает в разы быстрее (но в предыдущем примере он мне не подходит, т.к. мне там надо из одной и тойже таблици сделать от 2-х до N столбцов по "группировке по полю kod"

А если отчет фиксированной ширины, то быстрее сначала скопировать в dbase iV (copy to ... type fox2x as 866) или в excel (copy to ... type xls/ export to...). Потом открыть эту копию Excel`ем и скопировать куда надо.

Вот этот кусочек: