dbf自由表转excel后身份证号变科学计数法怎么办？
dbf自由表转excel后身份证号变科学计数法怎么办？能不能在程序里直接定义其输出到excel的格式？用了前辈的程序，想修改为输出字符型：
程序代码：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
[此贴子已经被作者于2016-11-19 11:12编辑过]
