竖鸡蛋的来历:DBFtoEXCEL

来源:百度文库 编辑:偶看新闻 时间:2024/04/30 12:53:57

 Lparameters dbfname
    *    RPTSHEET=Getobject('','excel.sheet')
    RPTSHEET=Createobject("excel.application")
    RPTSHEET.Visible=.F.
    XLAPP=RPTSHEET.Application
    XLAPP.WORKBOOKS.Add()
    XLSHEET=XLAPP.ACTIVESHEET
    RPTSHEET.Caption=dbfname+"_xzs"

    *!* 20.设置页脚、顶边距、底边距、左边距、右边距
    With RPTSHEET.ACTIVESHEET.PageSetup
        .CenterFooter="第&P页"
        .TopMargin=1/0.035
        .BottomMargin=2/0.035
        .LeftMargin=1/0.035
        .RightMargin=1/0.035
    Endwith

    Select &dbfname
    ** 创建报表头
    gnFieldcount = Afields(gaMyArray)  && 创建数组。
    For nCount = 1 To gnFieldcount
        XLAPP.CELLS(1,nCount).Value=gaMyArray(nCount,1)
        If Vartype(gaMyArray(nCount,1))='C'
            RPTSHEET.Columns(nCount).Select
            RPTSHEET.Selection.NumberFormatLocal = "@"  &&设置列格式为字符型
        Else
            RPTSHEET.Columns(nCount).Select
            RPTSHEET.Selection.HorizontalAlignment=4    &&其它类型右对齐
        Endif
        RPTSHEET.ACTIVESHEET.Columns(nCount).Font.Size=9
    Endfor

    Select &dbfname
    Go Top
    lccont=2 && 数据从第二行开始
    Scan
        For nCount = 1 To gnFieldcount
            &&判断单元格里是否为字符型,如果是则去掉前后空格 排版需要。
            &&上面是判断字段类型,这次判断 字段值类型
            If Vartype(&gaMyArray(nCount,1))='C'
                XLAPP.CELLS(lccont,nCount).Value=Alltrim(&gaMyArray(nCount,1))
            Else
                XLAPP.CELLS(lccont,nCount).Value=&gaMyArray(nCount,1)
            Endif
        Endfor
        lccont=lccont+1
    Endscan
    RPTSHEET.CELLS.EntireColumn.AutoFit  && 自动宽度
    *    WAIT CHR(gnFieldcount+64)+ALLTRIM(STR(lccont)) windows
    **   设置表格边线
    With RPTSHEET.ACTIVESHEET.Range("a1:"+Chr(gnFieldcount+64)+Alltrim(Str(lccont-1)))
        *        .BorderS(2).LineStyle=9
        .BorderS(1).Weight=2
        .BorderS(2).Weight=2
        .BorderS(3).Weight=2
        .BorderS(4).Weight=2
    Endwith
    RPTSHEET.Visible=.T.
    RPTSHEET.Cells(1,1).Select