如何简化代码（自动生成含有任课教师姓名的各班级课表） - VFP论坛

王咸美

等　级：新手上路
帖　子：666
专家分：3
注　册：2018-1-4
结帖率：97.5%

楼主

已结贴√ 问题点数：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

taifu945

等　级：贵宾
威　望：80
帖　子：1545
专家分：3298
注　册：2012-7-6

第 3 楼

得分:1

代码写上来没有什么太大的意义，你把源表的文件传上来，然后再详细说一下要达到什么目的(有结果样张的配图最好)。
别人根据你的要求写一段代码，你对比自己的代码看看，是否达到了优化的目标。

2020-03-24 16:17

sdta

来　自：江苏省连云港市
等　级：版主
威　望：335
帖　子：9848
专家分：27241
注　册：2012-2-5

第 5 楼

得分:11

VFP9控制EXCEL2003生成的课程表

图片附件: 游客没有浏览图片的权限，请登录或注册

坚守VFP最后的阵地

2020-03-25 00:55

sdta

来　自：江苏省连云港市
等　级：版主
威　望：335
帖　子：9848
专家分：27241
注　册：2012-2-5

第 7 楼

得分: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

xuminxz

等　级：贵宾
威　望：41
帖　子：766
专家分：2517
注　册：2011-5-8

第 9 楼

得分:8

打印课表.rar (8.86 KB)

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

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

dBase有人接盘了。

2020-03-25 16:21