|
* 编号：A0027
* 功能：巧让VFP数据生成Excel报表示例
* 说明：不能打印备注型和通用型字段
CLOSE DATABASES all
SET DATE YMD
SET CENTURY on
SET PATH TO d:\vfp98
USE RKQK200802 ALIAS FoxTable IN 0
m.outfilename=putfile('输出结果','RKQK','xls')
SELECT FoxTable
&&取导出文件名称
ef=CREATEOBJECT('Excel.application')
&&调用Excel程序
efapp=ef.application
efapp.Workbooks.add
efapp.activewindow.windowstate=2
&&添加工作簿
osheet=efapp.activesheet
&&激活第一个工作表
ef.visible=.t.
&&显示Excel界面
ef.Cells.Select
&&选择整张表
ef.Selection.Font.Size = 11
&&设置整表默认字体大小为11
num=reccount()
&&求导出总记录数
go top
i=5
ef.range("F1:K1").Select
&&选择标题栏所在单元格
ef.Selection.Merge
&&合并单元格
with ef.range("F1 ")
&&设置标题及字体属性
.value='陈集小学各科任课情况一览表'
.Font.Name="宋体"
.Font.bold=.t.
.Font.size=18
.Font.Color=RGB(255,0,0)
endwith
with ef.range("A3:P4 ")
&&设置字段名及字体属性
.Font.Name="华文新魏"
.Font.bold=.t.
.Font.size=12
endwith
ef.Rows(2).RowHeight=1/0.035
&&设置第二行高度为1cm
ef.range("M2:P2").Select
ef.Selection.Merge
&&合并单元格
ef.range("M2").Font.size=11
ef.range("M2").HorizontalAlignment=4
&&设置内容对齐方式为右对齐,3为居中，2为右对齐
ef.range("M2").value=' 制表日期：'+SUBSTR(DTOS(date()),1,4)+"年"+SUBSTR(DTOS(date()),5,2)+"月"+SUBSTR(DTOS(date()),7,2)+"日"+ ' '
ef.Rows("3:4").Select
with ef.Selection
.HorizontalAlignment = 3
&&设置3、4行为水平对齐
.VerticalAlignment = 2
&&垂直居中
.NumberFormatLocal = "@"
&&设置3、4行为字符型内容
endwith
ef.Range("A3:A4").Select
ef.Selection.Merge
&&纵向合并第一列3、4行
ef.Range("A3").Value='班级'
&&设置第一列标题内容
ef.Columns("A").Select
&&整列选择
ef.Selection.HorizontalAlignment = 3
&&水平居中
ef.Columns("A:B").Select
ef.Selection.NumberFormatLocal = "@"
&&设置A、B列为字符型内容
ef.Range("B3:B4").Select
ef.Selection.Merge
&&纵向合并第二列3、4行
ef.Range("B3").Value='班主任'
&&设置第二列标题内容
ef.Columns("B").Select
&&整列选择
ef.Selection.HorizontalAlignment = 3
&&水平居中
ef.Range("C3:C4").Select
ef.Selection.Merge
ef.Range("C3").Value='学生数'
ef.Columns("C").Select
ef.Selection.HorizontalAlignment=3
ef.Range("D3:E3").Select
ef.Selection.Merge
ef.Range("D3").Value='品德类课程'
ef.Range("D4").Value='品生'
ef.Range("E4").Value='品社'
ef.Range("F3:F4").Select
ef.Selection.Merge
ef.Range("F3").Value='科学'
ef.Range("G3:G4").Select
ef.Selection.Merge
ef.Range("G3").Value='语文'
ef.Range("H3:H4").Select
ef.Selection.Merge
ef.Range("H3").Value='数学'
ef.Range("I3:I4").Select
ef.Selection.Merge
ef.Range("I3").Value='英语'
ef.Range("J3:J4").Select
ef.Selection.Merge
ef.Range("J3").Value='体育'
ef.Range("K3:K4").Select
ef.Selection.Merge
ef.Range("K3").Value='音乐'
ef.Range("L3:L4").Select
ef.Selection.Merge
ef.Range("L3").Value='美术'
ef.Range("M3:O3").Select
ef.Selection.Merge
ef.Range("M3").Value='综合实践活动'
ef.Range("M4").Value='劳技'
ef.Range("N4").Value='信息'
ef.Range("O4").Value='综合'
ef.Range("P3:P4").Select
ef.Selection.Merge
ef.Range("P3").Value='科技文体'
nFldCount=AFIELDS(aFldList,"FoxTable")
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
LOOP
ENDIF
cFldName = aFldList[i,1]
vValue = EVALUATE(cFldName)
DO CASE
CASE aFldList[i,2] = "C" && 字符型
vValue = TRIM(vValue)
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)
ef.Cells(RECNO("FoxTable")+4,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)
ef.Columns(cColumn + ":" + cColumn).ColumnWidth =12
IF aFldList[i,2] = "M"
oSheet.Columns(cColumn + ":" + cColumn).WrapText = .f.
ENDIF
ENDFOR
for i=3 to reccount()+4
ef.Rows(i).RowHeight=0.68/0.035 && 设置从第3行开始每行高度0.68厘米
endfor
*efapp.Rows.EntireRow.AutoFit && 设置行高自动
efapp.Columns.EntireColumn.AutoFit && 设置列宽自动
efapp.ActiveSheet.PageSetup.PrintTitleRows="$1:$4" && 设置打印的顶端标;题行1-4行
efapp.ActiveSheet.PageSetup.CenterFooter="第&P页 共&N页"
*efapp.ActiveSheet.PageSetup.RightFooter="制表：王咸美" && 设置右页脚
efapp.ActiveSheet.PageSetup.CenterHorizontally=.t.
efapp.ActiveSheet.PageSetup.Orientation=2 && 设置纸张方向： 1--竖放 2--横放
efapp.ActiveSheet.PageSetup.PrintGridLines=.t. && 设置打印网格线
efapp.ActiveWindow.SelectedSheets.PrintPreview && 打印预览
efapp.ActiveWorkBook.SaveAs("E:\Mybook.xls") && 文件另存为
efapp.Quit
ef = .NULL.
efapp = .NULL.
WAIT CLEAR
=MESSAGEBOX("转换完毕！", 64, "OK")
CLOSE DATABASES ALL
RETURN
|
