VFP 导出到Excel 程序代码
首先, 我们新建一个表单, 命名为daochu.scx。在表单上添加 一个命令按钮, 并将其Caption 属性设置为“导出”。运行该表单 时, 单击导出, 用户可以选择需要导出的dbf 文件, 成功导出成Excel 文件并保存。“导出”命令按钮的Click 事件的代码设置[2]为:
cDbfFile = GETFILE("dbf") IF EMPTY(cDbfFile) RETURN ENDIF USE (cDbfFile) ALIAS FoxTable IN 0 &;&; 打开所选则的表并
定义别名为FoxTable
IF NOT USED("FoxTable") =MESSAGEBOX("打开表失败,
程序将中止! ", 16, "Error") RETURN ENDIF cExcelFile = PUTFILE("保存为(&;N):",JUSTSTEM(cDbfFile)+". xls","xls") &;&; 激活“另存为?”对话框, 设置默认保存文件名。 IF EMPTY(cExcelFile) CLOSE DATABASES ALL RETURN ENDIF SELECT FoxTable oExcelSheet = GETOBJECT("","Excel.Sheet") &;&; 产生Excel
对象
IF NOT TYPE("oExcelSheet") = "O" &;&; 如果oExcelsheet 不
是对象型函数
=MESSAGEBOX ("Excel 对象创建失败, 程序将中止! ",16," Error") RETURN ENDIF oExcelApp = oExcelSheet.Application oExcelApp.Workbooks.Add() &;&; 添加新工作簿 oExcelApp.ActiveWindow.WindowState=2 oSheet = oExcelApp.ActiveSheet nFldCount = AFIELDS(aFldList, "FoxTable") &;&;把当前表的结构信息存放在一个数组中, 并且返回表的
字段数。
FOR i = 1 TO nFldCount oSheet.Cells(1,i).Value = aFldList[i,1] &;&; 将表字段名复制到
对应的单元格中
ENDFOR cRecc = STR(RECCOUNT("FoxTable")) &;&; 返回当前表的记
录数目
SCAN &;&; 扫描指针当前的位置 WAIT WINDOW ALLTRIM (STR (RECNO ()))+ "/" + cRecc NOWAIT FOR i = 1 TO nFldCount vValue = .NULL. IF AT(aFldList[i,2], "CDLMNFIBYT") = 0 &;&; 如果字段类型不
是VFP 的字段类型
LOOP ENDIF cFldName = aFldList[i,1] vValue = EVALUATE(cFldName) &;&; 计算字符表达式的值并
返回结果
DO CASE CASE aFldList[i,2] = "C" &;&; 字符/字符串 vValue = TRIM(vValue) TRIM() 返回删除全部后缀空格后的
指定字符表达式
CASE aFldList[i,2] = "D" &;&; 日期 vValue = DTOC(vValue) CASE aFldList[i,2] = "T" &;&; 日期时间 vValue = TTOC(vValue) CASE INLIST(aFldList[i,2], "N", "F", "I", "B", "Y") &;&; 数值 CASE aFldList[i,2] = "L" &;&; 逻辑 CASE aFldList[i,2] = "M" &;&; 备注型 OTHERWISE vValue = .NULL. ENDCASE IF VARTYPE(vValue) = "C" AND EMPTY(vValue) LOOP ENDIF IF NOT ISNULL(vValue) &;&;判断vValue 结果是否为NULL 值 oSheet.Cells(RECNO("FoxTable")+1,i).Value = vValue &;&; 将
值导出到对应单元格中
ENDIF ENDFOR ENDSCAN cChrStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" FOR i = 1 TO nFldCount cColumn = SUBSTR(cChrStr,INT((i- 1)/26),1)+SUBSTR(cChrStr, IIF(MOD(i,26)=0,26,MOD(i,26)),1) oSheet.Columns(cColumn+ ":" + cColumn).ColumnWidth = 12 &;&; 命名
工作表列的名称并取得导入了数据的列的宽度 IF aFldList[i,2] = "M" oSheet.Columns(cColumn + ":" + cColumn).WrapText = .F. &;&; 设置备注型型字段列不自动换行
ENDIF ENDFOR oExcelApp.ActiveWorkbook.SaveAs(cExcelFile) &;&; 设置另存
为Excel 文件
oExcelApp.ActiveWorkbook.Close(.F.) &;&; 关闭工作簿 oExcelApp.Quit &;&; 退出Excel oExcelSheet = .NULL. oExcelApp = .NULL. &;&; 释放Excel 对象 WAIT CLEAR =MESSAGEBOX("转换完毕! ",64,"OK") CLOSE DATABASES ALL