如何在学校日课总表学科名称下面显示教师姓名?
如何在学校日课总表学科名称下面显示教师姓名?现有学校日课总表表文件kb20190101.dbf 各班任课教师表文件jsrkb20190101.dbf 模板文件kbmb1.doc kbmb2.doc,运行程序文件sckb20190101.prg后生成日课总表样表 日课总表(1-3年级样表)及日课总表(4-6年级)。程序文件sckb20190101.prg运行十分缓慢,如何修改程序,提高运行速度,还请高手不吝赐教,万分感谢!!!
课表文件.zip
(79.66 KB)
* sckb20190101.prg代码如下:
*功能:生成日课总表(科目下面显示教师姓名)
*!* 第一部分 生成全校教师表(jsb.dbf)
SET TALK OFF
SET SAFETY OFF
CLOSE TABLES all
SET COMPATIBLE OFF
cCurrentProcedure = SYS(16,1)
nPathStart = AT(":",cCurrentProcedure)- 1
nLenOfPath = RAT("\", cCurrentProcedure) - (nPathStart)
mypath=SUBSTR(cCurrentProcedure, nPathStart, nLenofPath)
SET Default TO (mypath)
USE jsrkb20190101 IN 0 ALIAS jsrkb20190101
USE kb20190101 IN 0 ALIAS kb20190101
*!* 日课总表字段扩大
SELECT kb20190101
zds=FCOUNT()
jls=RECCOUNT()
GO top
FOR i=3 TO zds
rdx=field(i)
*IF LEN(&rdx)<15
*ALTER table rkzb alter &rdx C(15)
*ENDIF
ENDFOR
COPY STRUCTURE TO jsb
*!* 日课总表逐条记录处理
SELECT kb20190101
DIMENSION jsmain(zds)
jsmain=""
FOR x=1 TO jls &&逐条记录
WAIT "正在处理 "+ALLTRIM(STR(x))+"//"+ALLTRIM(STR(jls)) WINDOW nowait
GO x
jsmain(1)=ALLTRIM(nj)
jsmain(2)=ALLTRIM(bj)
FOR y=3 TO zds &&记录中每个字段
rdy=field(y)
rdy0=&rdy
SELECT jsrkb20190101
LOCATE FOR nj=jsmain(1) AND bj=jsmain(2)
IF FOUND()
q=0
FOR z=3 TO zds
rdz=field(z)
IF rdz=ALLTRIM(rdy0)
q=1
EXIT
ENDIF
ENDFOR
IF q=1
*jsmain(y)=ALLTRIM(rdy0)+CHR(10)+ALLTRIM(&rdz)
jsmain(y)=ALLTRIM(&rdz)
ELSE
jsmain(y)=ALLTRIM(rdy0)
ENDIF
ELSE
jsmain(y)=ALLTRIM(rdy0)
ENDIF
SELECT kb20190101
ENDFOR
*!* 结果输出到jsb
INSERT INTO jsb FROM ARRAY jsmain
ENDFOR
*!* 第二部分 生成日课总表(1-3年级)
wjm=mypath+"\kbmb1.doc"
WordApp=CREATEOBJECT("Word.application")
WordApp.Visible =.t.
WordTable=WordApp.Application.Documents.Open[wjm] && 关键
*use kb20180920 ALIAS kb20180920 IN 0
*SELECT kb20180920
*USE jsb ALIAS jsb IN 0
*SELECT jsb
SELECT kb20190101
FOR i=3 TO FCOUNT()
FOR k=4 TO 19
GO k-3
WordCellText=EVALUATE(FIELD(i))
IF EMPTY(WordCellText) OR ISNULL(WordCellText)
WordCellText=" "
ENDIF
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Text=WordCellText
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Font.Bold=.t.
IF WordCellText="自习1" OR WordCellText="自习2"
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Font.Size=9
ELSE
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Font.Size=11
ENDIF
ENDFOR
ENDFOR
SELECT jsb
FOR i=3 TO FCOUNT()
FOR k=5 TO 20
GO k-4
WordCellText=EVALUATE(FIELD(i))
IF EMPTY(WordCellText) OR ISNULL(WordCellText)
WordCellText=" "
ENDIF
WordTable.Tables.item(1).Cell(k*2-5,i).Range.Text=WordCellText
WordTable.Tables.item(1).Cell(k*2-5,i).Range.Font.Size=8
WordTable.Tables.item(1).Cell(k*2-5,i).Range.font.Name="华文楷体"
ENDFOR
ENDFOR
myda=subst(dtos(date()),1,4)+subst(dtos(date()),5,2)+subst(dtos(date()),7,2)
WordApp.Documents(1).SaveAs("E:\日课总表(1-3年级)_"+myda+".doc") &&自动保存文件
RELEASE WordApp
* WAIT CLEAR
* MessageBox( "生成Word文件完毕,文件位置 E:\日课总表1-3年级)_"+myda+".doc!",64,"完毕")
*!* 第三部分 生成日课总表(4-6年级)
wjm=mypath+"\kbmb2.doc"
WordApp=CREATEOBJECT("Word.application")
WordApp.Visible =.t.
WordTable=WordApp.Application.Documents.Open[wjm] && 关键
*SELECT rkzb20180920
SELECT kb20190101
FOR i=3 TO FCOUNT()
FOR k=4 TO 21
GO k+13
WordCellText=EVALUATE(FIELD(i))
IF EMPTY(WordCellText) OR ISNULL(WordCellText)
WordCellText=" "
ENDIF
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Text=WordCellText
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Font.Size=11
WordTable.Tables.item(1).Cell(k*2-4,i).Range.Font.Bold=.t.
ENDFOR
ENDFOR
SELECT jsb
FOR i=3 TO FCOUNT()
FOR k=5 TO 22
GO k+12
WordCellText=EVALUATE(FIELD(i))
IF EMPTY(WordCellText) OR ISNULL(WordCellText)
WordCellText=" "
ENDIF
WordTable.Tables.item(1).Cell(k*2-5,i).Range.Text=WordCellText
WordTable.Tables.item(1).Cell(k*2-5,i).Range.Font.Size=8
WordTable.Tables.item(1).Cell(k*2-5,i).Range.font.Name="华文楷体"
ENDFOR
ENDFOR
myda=subst(dtos(date()),1,4)+subst(dtos(date()),5,2)+subst(dtos(date()),7,2)
WordApp.Documents(1).SaveAs("E:\日课总表(4-6年级)_"+myda+".doc") &&自动保存文件
RELEASE WordApp
* WAIT CLEAR
* MessageBox( "生成Word文件完毕,文件位置 E:\日课总表4-6年级)_"+myda+".doc!",64,"完毕")
RETURN
[此贴子已经被作者于2019-4-15 10:29编辑过]