在程序中如何根据字符长度确定字体大小?
在程序中如何根据字符长度确定字体大小,如字符长度超过12则字号设为8,其它为11号字。如在附件“学校日课总表2”中 自习2[蒋亚晨] 字号设为8,数学[蒋亚晨] 字号设为10,请高手帮忙,万分感谢!!!
生成每天课表.zip
(56.37 KB)
*!* 生成学校日课总表任课教师姓名
CLEAR ALL
CLOSE ALL
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)
jsmain(y)=ALLTRIM(rdy0)+"["+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
*select jsb
*browse
*!* 生成每天日课总表
FOR m=1 TO 5
SELECT jsb
wjm=mypath+"\kbmb_"+STR(m,1)+".doc"
FileName=mypath+"\学校日课总表"+STR(m,1)+".doc"
wordapp=CREATEOBJECT("word.application")
wordapp.visible=.t.
WordTable=wordapp.application.Documents.Open(wjm)
FOR i=m*6-3 TO m*6+2
FOR k=4 TO reccount()+3
GO k-3
WordCellText=EVALUATE(FIELD(i))
IF EMPTY(WordCellText) OR ISNULL(WordCellText)
WordCellText=" "
ENDIF
WordTable.Tables.item(1).Cell(k,i-6*(m-1)).Range.Text=WordCellText
WordTable.Tables.item(1).Cell(k,i-6*(m-1)).Range.Font.Bold=.f.
IF LEN("+WordCellText+")>12
WordTable.Tables.item(1).Cell(k,i-6*(m-1)).Range.Font.Size=8
ENDIF
ENDFOR
ENDFOR
WordApp.Documents(1).SaveAs(FileName) &&自动保存文件
WordApp.quit
RELEASE WordApp
ENDFOR
RETURN
[此贴子已经被作者于2021-11-9 13:42编辑过]