* выплевывает в xl текущую рабочую облать
* должна быть папка c:\u_t\xl\
*это *.prg файл
* писал еще для vfp50 -работает и сегодня.

local p_e,file_name
fl111=1
file_name='c:\u_t\xl\'+alltrim(substr(sys(2015),3,10))+'.dbf'
file_name_1='c:\u_t\xl\'+alltrim(substr(sys(2015),3,10))+'.xls'

IF USED()
aaa13231223=AFIELDS(arr_fields_ttett,alias())
if TYPE('f_list')='L'
copy to &file_name TYPE FOXPLUS as 866 &&DELIMITED WITH TAB
IF RECCOUNT(alias())>65534
msg64('Превышен лимит сток в XL !!! - '+ALLTRIM(STR(RECCOUNT(alias()))))
ENDIF

else
copy to &file_name &f_list TYPE FOXPLUS as 866
IF RECCOUNT(alias())>65535
msg64('Превышен лимит сток в XL !!! - '+ALLTRIM(STR(RECCOUNT(alias()))))
ENDIF

endif
else
wait wind 'Нет данных для выгрузки в Excel'
return
ENDIF
Fl111=1
cl222=1
ON ERROR DO ERR2
p_e=getobject(,'Excel.Application')
on error do err1
if cl222=0
P_E=CREATEOBJECT('EXCEL.APPLICATION')
endif
ON ERROR
IF Fl111=1
P_E.VISIBLE=.T.
P_E.WORKBOOKS.OPEN(file_name)


P_E.rows("1:1").select
p_e.selection.font.bold=.t.


P_E.cells.Select
p_e.selection.numberformat='#;-#;'
P_E.Selection.Columns.AutoFit
p_e.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
p_e.Rows("1:1").Select
IF !f_auto_fltr
p_e.Selection.AutoFilter
ENDIF

p_e.cells(1,1).select

p_e.ActiveWorkbook.SaveAs(file_name_1,43,'','',.f.,.f.)
delete file &file_name
RELEAS P_E
ENDIF
RETURN
*--------------------ERR1---------------
PROCEDURE ERR1
=MESSAGEBOX('Excel не инициализируется !!!'+chr(13)+chr(13)+;
'Попробуйте повторить ...',16,'О Ш И Б К А !!!')
Fl111=0
RETURN
*----------------err2-----
procedure err2
cl222=0
return

забыл - засунь в начало файла

parameters f_list,f_auto_fltr && f_list=char = поля в xl, f_auto_fltr=.t. & .f. включть сразу в ексель автофильтр