VFP 导出到Excel 程序代码.docx
VFP 导出到Excel 程序代码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 = aFldListi,1 && 将表字段名复制到 对应的单元格中 ENDFOR cRecc = STR(RECCOUNT("FoxTable") && 返回当前表的记 录数目 SCAN && 扫描指针当前的位置 WAIT WINDOW ALLTRIM (STR (RECNO )+ "/" + cRecc NOWAIT FOR i = 1 TO nFldCount vValue = .NULL. IF AT(aFldListi,2, "CDLMNFIBYT") = 0 && 如果字段类型不 是VFP 的字段类型 LOOP ENDIF cFldName = aFldListi,1 vValue = EVALUATE(cFldName) && 计算字符表达式的值并 返回结果 DO CASE CASE aFldListi,2 = "C" && 字符/字符串 vValue = TRIM(vValue) TRIM 返回删除全部后缀空格后的 指定字符表达式 CASE aFldListi,2 = "D" && 日期 vValue = DTOC(vValue) CASE aFldListi,2 = "T" && 日期时间 vValue = TTOC(vValue) CASE INLIST(aFldListi,2, "N", "F", "I", "B", "Y") && 数值 CASE aFldListi,2 = "L" && 逻辑 CASE aFldListi,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 aFldListi,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
