DBF导出到XLS.doc

这段代码的功能是将导出到XLS文件中，可以创建新的文档，也可以在原来的文档中添加工作薄，在成功操作之后，返回当前的XLS文件名，你可以在这基础上作循环处理。FUNCTION GetValidFileNamePARAMETERS FileNameLOCAL sFileNamem.sFileName=ALLTRIM(FileName)m.sFileName=STRTRAN(m.sFileName, )m.sFileName=STRTRAN(m.sFileName, )m.sFileName=STRTRAN(m.sFileName, )m.sFileName=STRTRAN(m.sFileName,/, )m.sFileName=STRTRAN(m.sFileName,|, )m.sFileName=STRTRAN(m.sFileName,?, )m.sFileName=STRTRAN(m.sFileName,*, )m.sFileName=STRTRAN(m.sFileName, )m.sFileName=STRTRAN(m.sFileName, )m.sFileName=STRTRAN(m.sFileName,:, )m.sFileName=STRTRAN(m.sFileName, )m.sFileName=STRTRAN(m.sFileName,： , )m.sFileName=STRTRAN(m.sFileName,。 , )m.sFileName=STRTRAN(m.sFileName,， , )m.sFileName=STRTRAN(m.sFileName,“ , )m.sFileName=STRTRAN(m.sFileName,” , )m.sFileName=ALLTRIM(m.sFileName)RETURN sFileNameENDFUNC*功能：将数据表的记录输出到EXCEL 中去。* SheetName ：Excel工作表名* SheetTitle ：Excel数据标题* DbfFile ：数据源* ExcelFile ：Excel文件* lNewXls ：创建还是添加到Excel文件中* sBz ：备注内容*FUNCTION DbfToXlsPARAMETER SheetName,SheetTitle,DbfFile,ExcelFile,lNewXls,sBzLOCAL FileOpen,noldarea,oCdialog,OldError,FileName,ColdPathColdPath=SYS(5)+SYS(2003)SheetName=GetValidFileName(ALLTRIM(SheetName)SheetTitle=GetValidFileName(ALLTRIM(SheetTitle)FileName=GetValidFileName(ExcelFile)ExcelFile=GetValidFileName(ExcelFile+IIF(UPPER(RIGHT(ExcelFile,4).XLS,.XLS,)IF lNewXls AND NOT EMPTY(ExcelFile) OR NOT FILE(ExcelFile) &如果是添加方式oCdialog=NEWOBJECT(mondialog)*oCdialog=CREATEOBJECT(mondialog)IF TYPE(oCdialog)O=MESSAGEBOX( 无法创建对象！, MB_OK+MB_ICONEXCLAMATION, ERRORTITLE_LOC)RETURN ENDIFOldError=ON(ERROR)ON ERROR oCdialog.FileName = *oCdialog.CancelError=.t.oCdialog.dialogTitle =SheetTitleoCdialog.FILTER=Excel文档(*.xls)|*.xlsoCdialog.MaxFileSize=20000oCdialog.FileName=excelfile &默认文件名oCdialog.ShowSave()ExcelFile=oCdialog.FileNameFileName=oCdialog.FileTitleRELEASE oCdialogON ERROR &OldErrorENDIFIF !EMPTY(ColdPath)*set default to &ColdPathENDIFIF EMPTY(FileName)RETURN ENDIFnoldarea=SELECT()FileOpen=.T.RetVal=.F.excelfile=ALLTRIM(excelfile)dbffile=ALLTRIM(dbffile)dbfname=SUBSTR(dbffile,RAT(,dbffile)+1,LEN(dbffile) &获得表名IF !USED(dbfname)IF !FILE(dbffile)=MESSAGEBOX( 数据文件：+dbffile+未找到！, MB_OK+MB_ICONEXCLAMATION, ERRORTITLE_LOC)RETURN ENDIFUSE &dbffile IN 0FileOpen=.F.ENDIFnRet=0IF FILE(ExcelFile).AND.lNewXls &如果是创建文件，则判断是否存在原文件nRet=MESSAGEBOX( ExcelFile+CHR(13)+已存在，要替换该文件吗？ , MB_YESNOCANCEL+MB_ICONEXCLAMATION+MB_DEFBUTTON2, TITLE_LOC )DO CASECASE nRet=IDYES=DeleteFile(ExcelFile) &利用API函数删除文件CASE nRet=IDCANCELRETURN ENDCASEENDIFtmpsheet = GETOBJECT(,excel.sheet)IF .NOT.(TYPE(tmpsheet)=O ) & U 未能产生EXCEL对象=MESSAGEBOX( 创建报表失败！ + CHR(13) + CHR(13) + ;请检查你的系统是否正确安装 EXCEL 软件！ , MB_OK+MB_ICONEXCLAMATION, ERRORTITLE_LOC)SELECT(noldarea)RETURN ENDIFxlapp = tmpsheet.APPLICATIONxlapp.VISIBLE = .F.*! 创建excel打印对象 *-IF FILE(ExcelFile)xlapp.WorkBooks.OPEN(ExcelFile)SheetsCount= xlapp.Sheets.COUNTi=1DO WHILE i=SheetsCount &查找文件中所有工作表，判断是否有相同的工作表IF UPPER(ALLTRIM(xlapp.Sheets(i).NAME)= UPPER(ALLTRIM(SheetName)nRet=MESSAGEBOX(“+ xlapp.Sheets(i).NAME+”工作表已经存在，要否删除该工作表？, MB_YESNO+MB_ICONEXCLAMATION+MB_DEFBUTTON2, TITLE_LOC )DO CASECASE nRet=IDYES &是 ：xlapp.DisplayAlerts = .F. &关闭警告提示xlapp.ActiveWorkbook.Sheets(i).DELETE &删除存在的工作表xlapp.DisplayAlerts = .T. &打开警告提示SheetsCount=SheetsCount-1 &减少一个工作表CASE nRet=IDNO &否 ：xlapp.activeWorkbook.CLOSE(.F.)xlapp.QUITxlapp=NULLRELEASE xlapp,tmpsheetRETURN &退出程序ENDCASEELSEi=i+1ENDIFENDDOxlapp.Sheets.ADD()ELSExlapp.workbooks.ADD()ENDIFxlapp.ActiveWindow.WINDOWSTATE = 2 & 最大化 打开的工作本xlsheet = xlapp.activesheet &选中当前激活的表IF EMPTY(SheetName)IF EMPTY(SheetTitle)xlsheet.NAME =DTOC(DATE()ELSEENTER=AT(CHR(13),SheetTitle)IF ENTER0xlsheet.NAME =LEFT(LEFT(SheetTitle,ENTER),30)ELSExlsheet.NAME =LEFT(SheetTitle,30)ENDIFENDIFELSExlsheet.NAME =LEFT(SheetName,30)ENDIF*! 创建excel打印对象 *-loForm = CREATEOBJECT(Thermomet,) &创建进度条loForm.SHOW()loForm.UPDATE(1)SELECT &dbfnameFieldCount=FCOUNT() &当前表中的字段数RecordCount=RECCOUNT() &当前表中的记录数IF EMPTY(SheetTitle) &如果没有表头，则从第一行开始。startline=1ELSEstartline=2ENDIFnFoot=IIF(EMPTY(m.sBz),0,2) &页脚是否有备注内容IF Fieldcount26IF MOD(Fieldcount,26)0ch1=CHR(ASC(A)+(INT(Fieldcount/26)-1)ch2=CHR(ASC(A)+(MOD(Fieldcount,26)-1)ELSEch1=CHR(ASC(A)+(INT(Fieldcount/26)-1)-1)ch2=ZENDIFch=ch1+ch2ELSEch=CHR(ASC(A)+Fieldcount-1)ENDIFarea=A+:+chtextarea=A+ALLTRIM(STR(startline)+:+ch+ALLTRIM(STR(RecordCount+startline+nFoot) &alltrim(str(Fieldcount)titlearea=A+ALLTRIM(STR(1)+:+ch+ALLTRIM(STR(1)IF !EMPTY(SheetTitle)ENTER=AT(CHR(13),SheetTitle)i=IIF(ENTER=0,0,1)DO WHILE ENTER0IF AT(CHR(13),SheetTitle,ENTER)0i=i+1ELSEEXITENDIFENDDOxlsheet.RANGE(titlearea).MergeCells=.T. &合并单元格xlsheet.ROWS(1:1).ROWHEIGHT =(i+1)*25xlsheet.ROWS(1:1).FONT.SIZE=16xlsheet.ROWS(1:1).FONT.bold=.T.xlsheet.ROWS(1:1).shrinktofit=.T. &自动收缩为适当尺寸有适应有效列宽xlsheet.ROWS(1:1).HorizontalAlignment = 3 & 水平方向: 2左对齐,3居中,4右对齐xlsheet.ROWS(1:1).VerticalAlignment = 2 & 垂直方向: 1靠上，2居中，3靠下xlsheet.Cells( 1,1).VALUE=SheetTitle &表标题ENDIFIF !EMPTY(sbz)Footarea=A+ALLTRIM(STR(RecordCount+startline+1)+:A+ALLTRIM(STR(RecordCount+startline+nFoot)xlsheet.RANGE(Footarea).MergeCells=.T. &合并单元格Footarea=B+ALLTRIM(STR(RecordCount+startline+1)+:+ch+ALLTRIM(STR(RecordCount+startline+nFoot)xlsheet.RANGE(Footarea).MergeCells=.T. &合并单元格xlsheet.Cells(RecordCount+startline+1,1).VALUE=说明 &表标题xlsheet.Cells(RecordCount+startline+1,2).VALUE=sbz &表标题ENDIF*xlsheet.columns(textarea).entirecolumn.autofitxlsheet.RANGE(textarea).FONT.SIZE=9 &全部字体为9号字xlsheet.RANGE(textarea).WrapText = .T. &自动换行*xlsheet.range(textarea).shrinktofit=.t. &自动收缩为适当尺寸有适应有效列宽xlsheet.RANGE(textarea).BORDERS(1).Weight = 2 &框线 宽度： 2细线 3粗线xlsheet.RANGE(textarea).BORDERS(2).Weight = 2 &框线 宽度： 2细线 3粗线xlsheet.RANGE(textarea).BORDERS(3).Weight = 2 &框线 宽度： 2细线 3粗线xlsheet.RANGE(textarea).BORDERS(4).Weight = 2 &框线 宽度： 2细线 3粗线FOR i=1 TO fieldcount*area=alltrim(str(startline)+:+alltrim(str(i)*fieldtype=type(field(i) &字段类型*if fieldtype=N* xlsheet.Rows(area).HorizontalAlignment = 4 & 水平方向: 2左对齐,3居中,4右对齐*else* xlsheet.Rows(area).HorizontalAlignment = 3 & 水平方向: 2左对齐,3居中,4右对齐*endifxlsheet.Cells( startline,i).HorizontalAlignment = 3 & 水平方向: 2左对齐,3居中,4右对齐xlsheet.Cells( startline,i).VerticalAlignment = 2 & 垂直方向: 1靠上，2居中，3靠下xlsheet.Cells( startline,i).VALUE=ALLTRIM(FIELD(i) &列标题（字段名字）xlsheet.Cells( startline,i).FONT.COLOR= RGB(0,0,255)xlsheet.Cells( startline,i).Interior.COLOR= RGB(192,192,192)*xlsheet.Cells( startline,i).shrinktofit=.t. &自动收缩为适当尺寸有适应有效列宽IF i26 &列超过26列IF MOD(i,26)0ch1=CHR(ASC(A)+(INT(i/26)-1)ch2=CHR(ASC(A)+(MOD(i,26)-1)ELSEch1=CHR(ASC(A)+(INT(i/26)-1)-1)ch2=ZENDIFch=ch1+ch2ELSEch=CHR(ASC(A)+i-1)ENDIFarea=ch+:+chxlsheet.COLUMNS(area).COLUMNWIDTH=IIF(LEN(FIELD(i)FSIZE(FIELD(i),LEN(FIELD(i),FSIZE(FIELD(i) &得到列宽IF xlsheet.COLUMNS(area).COLUMNWIDTH16*xlsheet.columns(area).columnwidth=16*xlsheet.columns(area).HorizontalAlignment = 2 & 水平方向: 2左对齐,3居中,4右对齐ENDIF*!* xlsheet.Cells(startline ,i).Borders(1).Weight = 2 &框线 宽度： 2细线 3粗线*!* xlsheet.Cells(startline ,i).Borders(2).Weight = 2 &框线 宽度： 2细线 3粗线*!* xlsheet.Cells(startline ,i).Borders(3).Weight = 2 &框线 宽度： 2细线 3粗线*!* xlsheet.Cells(startline ,i).Borders(4).Weight = 2 &框线 宽度： 2细线 3粗线ENDFORloForm.ShowTitle(正在进行数据输出，稍候（在此期间请勿执行 Excel 程序）)GO TOPFOR i=1 TO RecordCountlcPercent = RECN()/RECCOUNT()*100RetVal=loForm.UPDATE(lcPercent)IF RetValEXITENDIFFOR j=1 TO FieldCountfieldtype=TYPE(FIELD(j)IF fieldtype=Cxlsheet.Cells( i+startline,j).NumberFormatLocal=ENDIF*!* With Selection*!* .HorizontalAlignment = xlGeneral*!* .VerticalAlignment = xlBottom*!* .WrapText = True*!* .Orientation = 0*!* .AddIndent = False*!* .ShrinkToFit = False*!* .MergeCells = False*!* End Withfieldname=FIELD(j)IF NOT EMPTY(fieldname)fvalue=&fieldnameIF INLIST(fieldtype,N,D,Y,T).AND.EMPTY(fvalue)fvalue=ENDIFxlsheet.Cells( i+startline,j).VALUE=IIF(fieldtypeL,fvalue,IIF(fvalue,是,否) &字段内容IF INLIST(fieldtype,N,Y)xlsheet.Cells( i+startline,j).HorizontalAlignment = 4 & 水平方向: 2左对齐,3居中,4右对齐ELSExlsheet.Cells( i+startline,j).HorizontalAlignment = 3 & 水平方向: 2左对齐,3居中,4右对齐ENDIFxlsheet.Cells( i+startline,j).VerticalAlignment = 2 & 垂直方向: 1靠上，2居中，3靠下IF IIF(LEN(FIELD(j)FSIZE(FIELD(j),LEN(FIELD(j),FSIZE(FIELD(j)20xlsheet.Cells( i+startline,j).HorizontalA