标题:如何简化代码(自动生成含有任课教师姓名的各班级课表)
只看楼主
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
结帖率:96.99%
已结贴  问题点数:20 回复次数:10 
如何简化代码(自动生成含有任课教师姓名的各班级课表)
如何简化下列程序代码,自动生成含有任课教师姓名的各个班级课表?请高手赐教!


CLEAR ALL
CLOSE ALL
SET TALK OFF
SET SAFETY OFF
SET DATE TO YMD
SET MARK TO "-"
SET CENTURY ON
SET COMPATIBLE OFF
 
cCurrentProcedure = SYS(16,1)
nPathStart =AT(":",cCurrentProcedure)- 1
nLenOfPath = RAT("\",cCurrentProcedure) - (nPathStart)
mypath=SUBSTR(cCurrentProcedure,nPathStart, nLenofPath)
SET Default TO (mypath)
 
wjm=mypath+ "\bjkbmb3.doc"  && 班级课程表模板(含有标题行的空表)
PUBLIC cnj,cbj,cxkmc,i
WordApp=CREATEOBJECT("Word.application")  
WordApp.Visible =.t.
 
SELECT 0
USE jsrkb alia bjb
SCAN
 cnj=bjb.nj
 cbj=bjb.bj
 WAIT WINDOW '正在生成“  ' +cnj+ cbj+ '  ”的日课表……' NOWAIT
 SELECT * from rkzb201803 where nj=cnj and bj=cbj into table bjkb
 SELECT bjkb
 WordTable=WordApp.Application.Documents.Open(wjm)    && 关键
 wordapp.selection
 wordapp.Selection.InsertAfter(ALLTRIM("&cnj&cbj"))     && 在模板文件标题行插入年级、班级
 WordTable.Tables.item(1).Cell(2,3).Range.Text=bjkb.Zhou11
 cxkmc=ALLTRIM(bjkb.zhou11)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(3,3).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(4,3).Range.Text=bjkb.Zhou12
 cxkmc=ALLTRIM(bjkb.zhou12)
 SELECT bjb
  FORi=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(5,3).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(6,3).Range.Text=bjkb.Zhou13
 cxkmc=ALLTRIM(bjkb.zhou13)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(7,3).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(8,3).Range.Text=bjkb.Zhou14
 cxkmc=ALLTRIM(bjkb.zhou14)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(9,3).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(10,3).Range.Text=bjkb.Zhou15
 cxkmc=ALLTRIM(bjkb.zhou15)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(11,3).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(12,3).Range.Text=bjkb.Zhou16
 cxkmc=ALLTRIM(bjkb.zhou16)
  SELECTbjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(13,3).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 
 
 WordTable.Tables.item(1).Cell(2,4).Range.Text=bjkb.Zhou21
 cxkmc=ALLTRIM(bjkb.zhou21)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(3,4).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(4,4).Range.Text=bjkb.Zhou22
 cxkmc=ALLTRIM(bjkb.zhou22)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(5,4).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(6,4).Range.Text=bjkb.Zhou23
 cxkmc=ALLTRIM(bjkb.zhou23)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(7,4).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(8,4).Range.Text=bjkb.Zhou24
 cxkmc=ALLTRIM(bjkb.zhou24)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(9,4).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(10,4).Range.Text=bjkb.Zhou25
 cxkmc=ALLTRIM(bjkb.zhou25)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(11,4).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(12,4).Range.Text=bjkb.Zhou26
 cxkmc=ALLTRIM(bjkb.zhou26)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(13,4).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 
 
 WordTable.Tables.item(1).Cell(2,5).Range.Text=bjkb.Zhou31
 cxkmc=ALLTRIM(bjkb.zhou31)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(3,5).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(4,5).Range.Text=bjkb.Zhou32
 cxkmc=ALLTRIM(bjkb.zhou32)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(5,5).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(6,5).Range.Text=bjkb.Zhou33
 cxkmc=ALLTRIM(bjkb.zhou33)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(7,5).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(8,5).Range.Text=bjkb.Zhou34
 cxkmc=ALLTRIM(bjkb.zhou34)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(9,5).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(10,5).Range.Text=bjkb.Zhou35
 cxkmc=ALLTRIM(bjkb.zhou35)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(11,5).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(12,5).Range.Text=bjkb.Zhou36
 cxkmc=ALLTRIM(bjkb.zhou36)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(13,5).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 
 
 WordTable.Tables.item(1).Cell(2,6).Range.Text=bjkb.Zhou41
 cxkmc=ALLTRIM(bjkb.zhou41)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(3,6).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(4,6).Range.Text=bjkb.Zhou42
 cxkmc=ALLTRIM(bjkb.zhou42)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(5,6).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(6,6).Range.Text=bjkb.Zhou43
 cxkmc=ALLTRIM(bjkb.zhou43)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(7,6).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(8,6).Range.Text=bjkb.Zhou44
 cxkmc=ALLTRIM(bjkb.zhou44)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(9,6).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(10,6).Range.Text=bjkb.Zhou45
 cxkmc=ALLTRIM(bjkb.zhou45)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(11,6).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(12,6).Range.Text=bjkb.Zhou46
 cxkmc=ALLTRIM(bjkb.zhou46)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(13,6).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 
 
 WordTable.Tables.item(1).Cell(2,7).Range.Text=bjkb.Zhou51
 cxkmc=ALLTRIM(bjkb.zhou51)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(3,7).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(4,7).Range.Text=bjkb.Zhou52
 cxkmc=ALLTRIM(bjkb.zhou52)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(5,7).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(6,7).Range.Text=bjkb.Zhou53
 cxkmc=ALLTRIM(bjkb.zhou53)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(7,7).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(8,7).Range.Text=bjkb.Zhou54
 cxkmc=ALLTRIM(bjkb.zhou54)
 SELECT bjb
  FORi=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(9,7).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(10,7).Range.Text=bjkb.Zhou55
 cxkmc=ALLTRIM(bjkb.zhou55)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(11,7).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 WordTable.Tables.item(1).Cell(12,7).Range.Text=bjkb.Zhou56
 cxkmc=ALLTRIM(bjkb.zhou56)
 SELECT bjb
  FOR i=1 to FCOUNT()
   IF FIELD(i)=cxkmc
     WordTable.Tables.item(1).Cell(13,7).Range.Text=EVALUATE(FIELD(i))
   ENDIF
 ENDFOR
 
 filename=mypath+ "\"+ cnj +cbj+ "课程表.doc"
 WordApp.Documents(1).SaveAs(filename) &&自动保存文件
 WordApp.ActiveDocument.Close
 SELECT bjkb
  USE
 SELECT bjb
 WAIT CLEAR
ENDSCAN
wordapp.application.quit
MESSAGEBOX("班级日课表的word文档,生成完毕!",64,"提示:")
QUIT
 
 
搜索更多相关主题的帖子: Cell Text FIELD Tables item 
2020-03-24 11:40
xuminxz
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:40
帖 子:749
专家分:2475
注 册:2011-5-8
得分:0 
你这样没有注释的代码别人是无法帮你简化的。有几个建议仅供参考。
1.数据处理与准备与数据导出分开较好,不要计算一条数据导出一条数据。
可以先将数据写入到一个VFP临时表中,这个表可以由以下几个字段,bj 班级内容,bjxh 班级序号(流水号),zc 周次(星期几),jc 节次,nr 上课内容。其中,可以根据班级分组决定写入到哪个表格中,周次、节次决定内容写入的单元格的行、列。
导出数据时,从这一临时表中获得数据,这样代码就会清晰一点,也便于用循环减少代码量,并且便于调式。
2、调用关键文件前一定要有检查,同时,不要把模板等文件名称固化到代码中,可以用表单选择模板文件。
3、调整程序
分别调式数据准备代码与写入文件的代码。

dBase有人接盘了。
2020-03-24 15:40
taifu945
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:80
帖 子:1545
专家分:3298
注 册:2012-7-6
得分:1 
代码写上来没有什么太大的意义,你把源表的文件传上来,然后再详细说一下要达到什么目的(有结果样张的配图最好)。
别人根据你的要求写一段代码,你对比自己的代码看看,是否达到了优化的目标。
2020-03-24 16:17
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
得分:0 
现将学校日课总表rkzb201803.dbf、各班教师任课表jsrkb.dbf、班级课表模板文件bjkbmb3.doc、生成的班级课表样式打包成压縮文件呈上来,请高手用vfp调用模板文件生成各班级课表,万分感谢!!!
生成班级课表.rar (211.34 KB)
2020-03-24 18:46
sdta
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:江苏省连云港市
等 级:版主
威 望:323
帖 子:9621
专家分:26174
注 册:2012-2-5
得分:11 
VFP9控制EXCEL2003生成的课程表



坚守VFP最后的阵地
2020-03-25 00:55
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
得分:0 
怎么做到的?能分享一下具体代码吗?十分期盼!万分感谢!!!
2020-03-25 06:32
sdta
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:江苏省连云港市
等 级:版主
威 望:323
帖 子:9621
专家分:26174
注 册:2012-2-5
得分:0 
课程表模板.rar (5.02 KB)

程序代码:
CLOSE DATABASES 
*
CREATE CURSOR jskb (nj c(6), bj c(7), jsxm c(8), kc c(6))
USE jsrkb IN 0
SELECT jsrkb
SCAN 
    FOR i = 3 TO FCOUNT()
        ckc = FIELD(i)
        IF NOT EMPTY(EVALUATE("jsrkb." + ckc))
            INSERT INTO jskb VALUES (jsrkb.nj, jsrkb.bj, EVALUATE("jsrkb." + ckc), ckc)
        ENDIF 
    ENDFOR
ENDSCAN
*!*    SELECT jskb
*!*    BROWSE 
*
CREATE CURSOR rkzb (nj c(6), bj c(7), kc c(6), jc c(6), jsxm c(8))
USE rkzb201803 IN 0
SELECT rkzb201803
SCAN 
    FOR i = 3 TO FCOUNT()
        ckc = FIELD(i)
        INSERT INTO rkzb VALUES (rkzb201803.nj, rkzb201803.bj, EVALUATE("rkzb201803." + ckc), ckc, "")
    ENDFOR
ENDSCAN
SELECT rkzb
INDEX on nj + bj + kc TAG fh
SELECT jskb
SET RELATION TO nj + bj + kc INTO rkzb
SET SKIP TO rkzb
SCAN 
    REPLACE jsxm WITH jskb.jsxm IN rkzb
ENDSCAN
SET RELATION TO 
SET SKIP TO
SELECT rkzb
SET ORDER TO 
*BROWSE 
SELECT DISTINCT ALLTRIM(nj) + ALLTRIM(bj) njbj FROM rkzb201803 INTO CURSOR njbj
SCAN &&FOR RECNO() <= 4
    cName = njbj
    CREATE CURSOR kcb (w1 c(8), w2 c(8), w3 c(8), w4 c(8), w5 c(8))
    SELECT kc, jsxm FROM rkzb WHERE ALLTRIM(nj) + ALLTRIM(bj) == cName INTO CURSOR temp 
    nCnt1 = 0
    nCnt2 = 1 
    cName = cName + "课程表"
    LOCAL akc[12, 5]
    SCAN 
        FOR i = 1 TO FCOUNT()
            nCnt1 = nCnt1 + 1
            akc[nCnt1, nCnt2] = EVALUATE(FIELD(i))
        ENDFOR
        IF nCnt1 % 12 = 0
            nCnt2 = nCnt2 + 1
            nCnt1 = 0
        ENDIF 
    ENDSCAN
    SELECT kcb
    INSERT INTO kcb FROM ARRAY akc
    oExcel=CREATEOBJECT('Excel.Application')
    WITH oExcel
        .WorkBooks.Open(SYS(5)+SYS(2003)+"\课程表模板.xls")
        SCAN 
            .ActiveSheet.Cells(RECNO() + 4, 3).value = ALLTRIM(w1)
            .ActiveSheet.Cells(RECNO() + 4, 4).value = ALLTRIM(w2)
            .ActiveSheet.Cells(RECNO() + 4, 5).value = ALLTRIM(w3)
            .ActiveSheet.Cells(RECNO() + 4, 6).value = ALLTRIM(w4)
            .ActiveSheet.Cells(RECNO() + 4, 7).value = ALLTRIM(w5)
        ENDSCAN 
        .ActiveSheet.Cells(1, 1).value = cName
        .DisplayAlerts = .F.
        .ActiveWorkbook.Saveas(SYS(5)+SYS(2003)+"\" + cName + ".XLS", -4143)
        .ActiveWorkbook.Close
        .DisplayAlerts = .T.
        .Quit
        RELEASE oExcel
    ENDWITH 
ENDSCAN 

坚守VFP最后的阵地
2020-03-25 08:15
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
得分:0 
@sdta谢谢你!衷心感谢!
2020-03-25 09:31
xuminxz
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:40
帖 子:749
专家分:2475
注 册:2011-5-8
得分:8 
打印课表.rar (8.86 KB)

不会改原来的程序,按要求写了一个。模板文件有小的改变,将标题放在表格(隐藏了边框)一中,课表放在表格二中。代码比你的应该少一点。

[此贴子已经被作者于2020-3-25 16:23编辑过]


dBase有人接盘了。
2020-03-25 16:21
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
得分:0 
@xuminxz谢谢你!
2020-03-26 07:06



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-500547-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.353015 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved