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
联系客服