免费下载应用软件、交流使用经验。

软件下载 经验交流 软件开发 专题论述 请君留言 网站介绍 休闲时光 返回主页
 
将工作区中的表转换为EXCEL

作者:本人     来源:本站

***这是自动对当前工作区中打开的表转换为EXCEL的程序
IF USED()
    NEWEXCEL=CREATEOBJECT("EXCEL.APPLICATION")    &&建立EXCEL文件
    WITH NEWEXCEL
        .WORKBOOKS.ADD                            &&添加新EXCEL表
        nFd=AFIELDS(aTitl)                        &&取总字段数及各字段名、属性等
        FOR I = 1 TO nFd
            .CELLS(1,I)=ALLTRIM(aTitl(I,1))       &&将数组中的标题写入第一行
        ENDFOR
    ENDWITH
    GOTO TOP
    nHbh=2
    ON ERROR .CELLS(nHbh,I)="---"
    DO WHILE !EOF()                               &&开始对记录的循环
        FOR I = 1 TO nFd                          &&对记录中的每个字段进行处理
            cFild=ALLTRIM(aTitl(I,1))             &&组成“表名.字段名”
            WITH NEWEXCEL
                .CELLS(nHbh,I)=&cFild
            ENDWITH
        ENDFOR
        nHbh=nHbh+1
        SKIP
    ENDDO
    MESSAGEBOX("数据导出已经完成,请注意保存文件!",64,"操作提示")
    NEWEXCEL.ACTIVESHEET.PAGESETUP.ORIENTATION=1
    NEWEXCEL.VISIBLE=.T.                          &&显示excel表以便继续编辑和保存
    ON ERROR 
ENDIF 
RETURN

这个程序发布在论坛之后,有网友在使用过程中发现在转换类似身份证号码等字符型长数字串时会自动变成科学记数法,经修改后下面的程序就解决了这个问题。

IF USED()
    NEWEXCEL=CREATEOBJECT("EXCEL.APPLICATION")    &&建立EXCEL文件
    WITH NEWEXCEL
        .WORKBOOKS.ADD                            &&添加新EXCEL表
        nFd=AFIELDS(aTitl)                        &&取总字段数及各字段名、属性等
        FOR I = 1 TO nFd
            .CELLS(1,I)=ALLTRIM(aTitl(I,1))       &&将数组中的标题写入第一行
            IF aTitl(I,2)="C"                     &&设置单元格的文本属性
                cStr="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                cColu=SUBSTR(cStr,INT((I-1)/26),1)+SUBSTR(cStr,IIF(MOD(I,26)=0,26,MOD(I,26)),1)
                .Columns(cColu+":"+cColu).NumberFormatLocal="@"
            ENDIF 
        ENDFOR
    ENDWITH
    GOTO TOP
    nHbh=2
    ON ERROR .CELLS(nHbh,I)="---"
     DO WHILE !EOF()                               &&开始对记录的循环
        FOR I = 1 TO nFd                          &&对记录中的每个字段进行处理
            cFild=ALLTRIM(aTitl(I,1))             &&组成“表名.字段名”
            cFild=&cFild
            IF VARTYPE(cFild)="N"
                IF cFild#0
                    NEWEXCEL.CELLS(nHbh,I)=cFild  &&数值不为零则写入,
                ENDIF 
            ELSE
                IF VARTYPE(cFild)="C"
                    cFild=RTRIM(cFild)            &&字符字段则截去尾部空格
                    NEWEXCEL.CELLS(nHbh,I).NumberFormatLocal="@"&&设置单元格属性为文本
                ENDIF
                NEWEXCEL.CELLS(nHbh,I)=cFild
            ENDIF 
        ENDFOR
        nHbh=nHbh+1
        SKIP
    ENDDO
    MESSAGEBOX("数据导出已经完成,请注意保存文件!",64,"操作提示")
    NEWEXCEL.ACTIVESHEET.PAGESETUP.ORIENTATION=1
    NEWEXCEL.VISIBLE=.T.                          &&显示excel表以便继续编辑和保存
    ON ERROR 
ENDIF 
RETURN

注:

发表日期:2009-1-25     修改日期:

备案序号:赣ICP备05002359号

建议使用1024*768分辩率浏览 ☆版权所有 摘抄或转载须得到书面许可☆ Hujiajun ©1999,2016
E-Mail: hu-jj@21cn.com