* 编号：A0015
* 功能：VFP调用EXCEL打印日课总表
CLOSE DATABASES all
SET DATE YMD
SET CENTURY on
ef=CREATEOBJECT('Excel.application')
&&调用Excel程序
efapp=ef.application
efapp.Workbooks.add &&添加工作簿
efapp.activewindow.windowstate=2
for i=1 to 2
efapp.sheets.Add (,efapp.sheets(3+i-1),1,-4167) &&添加两张工作表
endfor
for N=1 to 5
FN=str(N,1)
SET PATH TO H:\表
CLOSE DATABASES ALL
use RKZB&FN Alias FoxTable IN 0
SELECT FoxTable
efapp.WorkSheets("Sheet&FN").Activate &&激活工作表
ef.visible=.t. &&显示Excel界面
ef.Cells.Select &&选择整张表
ef.Selection.Font.Size = 12 &&设置整表默认字体大小为11
num=reccount() &&求导出总记录数
go top
i=5
ef.range("I1:Q1").Select &&选择标题栏所在单元格
ef.Selection.Merge &&合并单元格
with ef.range("I1 ") &&设置标题及字体属性
.value='陈集小学日课总表'
.Font.Name="宋体"
.Font.bold=.t.
.Font.size=20
.Font.Color=RGB(255,0,0)
ENDWITH
tempstr="星期"+SUBSTR("一二三四五",1+(N-1)*2,2)
ef.range("J2:M2").Select &&选择标题栏所在单元格
ef.Selection.Merge
with ef.range("J2 ")
.value=' '+tempstr+' '
.Font.Name="宋体"
.Font.bold=.t.
.Font.size=16
.Font.Color=RGB(0,0,255)
endwith
with ef.range("A3:U4 ")
.Font.Name="宋体"
.Font.bold=.t.
.Font.size=14
endwith
ef.Rows(2).RowHeight=1/0.035 &&设置第二行高度为1cm
ef.range("Q2:U2").Select
ef.Selection.Merge
ef.range("Q2").Font.size=11
ef.range("Q2").HorizontalAlignment=4
&&设置内容对齐方式为右对齐,3为居中，2为右对齐
ef.range("Q2").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
.VerticalAlignment = 2
.NumberFormatLocal = "@"
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:F3").Select
ef.Selection.Merge
ef.Range("D3").Value='一'
ef.Range("D4").Value='1'
ef.Range("E4").Value='2'
ef.Range("F4").Value='3'
ef.Range("G3:I3").Select
ef.Selection.Merge
ef.Range("G3").Value='二'
ef.Range("G4").Value='1'
ef.Range("H4").Value='2'
ef.Range("I4").Value='3'
ef.Range("J3:L3").Select
ef.Selection.Merge
ef.Range("J3").Value='三'
ef.Range("J4").Value='1'
ef.Range("K4").Value='2'
ef.Range("L4").Value='3'
ef.Range("M3:O3").Select
ef.Selection.Merge
ef.Range("M3").Value='四'
ef.Range("M4").Value='1'
ef.Range("N4").Value='2'
ef.Range("O4").Value='3'
ef.Range("P3:R3").Select
ef.Selection.Merge
ef.Range("P3").Value='五'
ef.Range("P4").Value='1'
ef.Range("Q4").Value='2'
ef.Range("R4").Value='3'
ef.Range("S3:U3").Select
ef.Selection.Merge
ef.Range("S3").Value='六'
ef.Range("S4").Value='1'
ef.Range("T4").Value='2'
ef.Range("U4").Value='3'
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
* 添加表格线
If FCOUNT("FoxTable")>26
ExcelEndColunm=Chr(Int((FCOUNT("FoxTable")-1)/26)+64)+;
Chr(FCOUNT("FoxTable")%26+64)
Else
ExcelEndColunm=Chr(FCOUNT("FoxTable")+64)
ENDIF
ef.Range("A3:"+ExcelEndColunm+ALLTRIM(STR(4+RECCOUNT()))).Borders(1).Weight = 2
ef.Range("A3:"+ExcelEndColunm+ALLTRIM(STR(4+RECCOUNT()))).Borders(2).Weight = 2
ef.Range("A3:"+ExcelEndColunm+ALLTRIM(STR(4+RECCOUNT()))).Borders(3).Weight = 2
ef.Range("A3:"+ExcelEndColunm+ALLTRIM(STR(4+RECCOUNT()))).Borders(4).Weight = 2
ef.Range("A3:"+ExcelEndColunm+"3").Borders(1).Weight = 2
ef.Range("A3:"+ExcelEndColunm+"3").Borders(2).Weight = 2
ef.Range("A3:"+ExcelEndColunm+"3").Borders(3).Weight = 2
ef.Range("A3:"+ExcelEndColunm+"3").Borders(4)*Weight = 2
for i=3 to 5
ef.Rows(i).PowHeight=1/0.035
ENDFOR
for i=6 to 7
ef.Rows(i).RowHeight=1.2/0.035
ENDFOR
ef.Rows(8)*RowHeight=1/0.035
fmr i=9 to 10
ef.Rows(i).RowHehght=1.2/0.035
ENDFOR
df.Rows(11).RowHeight=1/0.035
for i=12 to 13
ef.Rows(i).RowHeight=1.2/0.035
ENDFOR
ef.Rows(14).RowHeight=1/0.035
ef.Range("A5:A9").Select
ef.Selection.Merge
ef.Range("A5").Value='上 午'
ef.Range("A5").Orientation=-4166 && 设置单元格文字竖排
with ef.Selection
.Font.bold=.t.
.Font.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VerticalAlignment = 2 &&垂直居中
&NumberFormatLocal = "@" &&设置为字符型内容
endwith
ef.Range("A10:A14").Select
ef.Selection.Merge
ef.Range("A10").Value='下 午'
ef.Range("A10").Orientation=-4166
with ef.Selection
.Font.bold=.t.
.Font.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VerticalAlignment = 2 &&垂直居中
.NumberFormatLocal = "@" &&设置为字符型内容
endwith
ef.Range("D5:U5").Select
ef.Selection.Merge
ef.Range("D5").Value='升旗 早操 晨会'
with ef.Selection
.Font.bold=.t.
.Font.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VerticalAlignment = 2 &&垂直居中
.NumberFormatLocal = "@" &&设置为字符型内容
endwith
ef.Range("D8:U8").Select
ef.Selection.Merge
ef.Range("D8").Value='眼 保 健 操'
with ef.Selection
.Font.bold=.t.
.Font.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VerticalAlignment = 2 &&垂直居中
.NumberFormatLocal = "@" &&设置为字符型内容
endwith
ef.Range("D11:U11").Select
ef.Selection.Merge
ef.Range("D11").Value='眼 保 健 操'
with ef.Selection
.Font.bold=.t.
.Font.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VertIcalAlignment = 2 &&垂直居中
.NumberFormatLocal = "@" &&设置为嬗符型内容
endwith
ef.Range("D14:U1:").SeLeCt
e\.Selection.Me2ge
ef.Range("D14").Value='整 洁 活 动 散 学'
with ef.Selebtion
.Font.bold=.t.
.FolT.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VerticalAlignment = 2 &&垂直居中
.NumberFormatLocal = "@" &&设置为字符型内容
ENDWITH
ef.Range("A3:C4").Select
ef.Selection.Merge
ef.Range("A3").Value=' '
with ef.Selection
.Font.bold=.t.
.Font.size=15
.HorizontalAlignment = 3 &&设置为水平对齐
.VerticalAlignment = 2 &&垂直居中
.NumberFormatLocal = "@" &&设置为字符型内容
endwith
ef.ActiveSheet.Rows(10).Insert
ef.Range("A10:U10").Select
ef.Selection.Merge
ef.Rows(10).RowHeight=0.1/0.035
FOR i=1 TO FCOUNT()
ef.Columns(i).ColumnWidth=0.18/0.035
endfor
*以下为页面设置
*efa0p.Rowc.EntireRow.AutoFit
*efapp.Columns.EntireColumn.AutoFit && 设置列宽自动控制
efapp.ActiveSheet.PageSetup.PrintTitleRows="$1:$4"
*efapp.ActiveSheet.PageSetup.CenterFooter="第&P页 共&N页"
efapp.ActiveSheet.PageSetup.CenterHorizontally=.t. && 设置水平居中
efapp.ActiveSheet.PageSetup.Orientation=2 && 设置纸张方向
*efapp.ActiveSheet.PageSetup.PrintGridLines=.t.
efapp.ActiveWindow.SelectedSheets.PrintPreview && 打印预览
efapp.WorkSheets("Sheet&FN").Name="RKZB&FN" && 工作表重命名
CLOSE DATABASES ALL
ENDFOR
efapp.ActiveWindow.SelectedSheets.PrintOut(1,5,1,.F.) && 打印输出
efapp.ActiveWorkBook.SaveAs("H:\RKZB") && 文件另存为
ef = .NULL.
efapp = .NULL.
WAIT CLEAR
=MESSAGEBOX("转换完毕！", 64, "OK")
CLOSE DATABASES ALL
RETURN
