如何由表文件shsmd.dbf生成“2021年普通高中省级三好学生名单.doc

程序代码：

Close Tables All 

cCurrentProcedure = Sys(16,1)

nPathStart = At(':',cCurrentProcedure)- 1 

nLenOfPath = Rat('\', cCurrentProcedure) - (nPathStart)

mypath=Substr(cCurrentProcedure, nPathStart, nLenofPath) 

Set Default To (mypath) 

 _fnm=Sys(5)  Sys(2003) '\模板.docx'

_Onm=Sys(5)  Sys(2003) '\2021年普通高中省级三好学生名单.docx' 

 Declare Long SetForegroundWindow In user32.Dll Long &&设置顶层窗口

Declare Long FindWindow In WIN32API String lpClassName,StringlpWindowName &&第一个参数写 null才行！

oWrd_hWnd=FindWindow(Null,Justfname(_fnm) ' - Word') 

If oWrd_hWnd<>0 SetForegroundWindow(owrd_hwnd) wdrs=Getobject(,'word.application') 

 wdrs.WindowState=2 && 0 普通 1 最大化 2 最小化Else wdrs=Createobject('word.application') &&创建Word目标测试是否安装word *

wdrs.documents.Open(_fnm) 

Endif 

wdrs.Visible=.T.

wdrs.activedocument.SaveAs(_Onm）

SELECT 所在市 dsmc From shsmd INTO CURSOR mp1 READWRITE 

DELETE ALL 

SELECT DISTINCT 所在市 dsmc From shsmd INTO CURSOR mpmp

scan 

 _dsmc=ALLTRIM(dsmc) 

  SELECT mp1 

 LOCATE FOR _dsmc==ALLTRIM(dsmc) 

 RECALL 

 ENDSCAN 

 SELECT * FROM mp1 INTO CURSOR sqtemp WHERE !DELETED() 

Scan 

 _dsmc=Alltrim(dsmc) 

  Select 性别 xb,姓名 xm,学校和班级 dw From shsmd Where Alltrim(所在市)==_dsmc Into Cursor mpmp 

 _addrows=Ceiling(Reccount('mpmp')/2) _rs1=wdrs.activedocument.Tables(1).Rows.Count 2 wdrs.activedocument.Tables(1).Rows.Last.Select wdrs.Selection.InsertRowsBelow(_addrows 2) 

  With wdrs.ActiveDocument.Tables(1) 

 .Cell(_rs1-1,1)

.Merge(.Cell(_rs1-1,6)) 

 .cell(_rs1-1,1).Range.Text=_dsmc 

 .cell(_rs1-1,1).range.Font.Size=14 

 .cell(_rs1-1,1).range.Font.Bold=.t. 

 .cell(_rs1-1,1).range.Font.name='宋体'

.cell(_rs1-1,1).Borders(-2). LineStyle =0 

 .cell(_rs1-1,1).Borders(-4). LineStyle =0 

 .cell(_rs1,1).Range.Text='姓 名'

.cell(_rs1,2).Range.Text='性别'

.cell(_rs1,3).Range.Text='所 在 学 校 和 班 级' 

 .cell(_rs1,4).Range.Text='姓 名' 

 .cell(_rs1,5).Range.Text='性别' 

 .cell(_rs1,6).Range.Text='所 在 学 校 和 班 级' 

 i=1 

 Do While !Eof('mpmp')

 i=i  1 

 _xm=Alltrim(mpmp.xm)

 _xb=Alltrim(mpmp.xb) 

 _dw=Alltrim(mpmp.dw) 

 .cell(_rs1 Int(i/2),4-3*Mod(Recno(),2)).Range.Text=_xm 

 .cell(_rs1 Int(i/2),5-3*Mod(Recno(),2)).Range.Text=_xb 

 .cell(_rs1 Int(i/2),6-3*Mod(Recno(),2)).Range.Text=_dw 

 Skip In mpmp 

Endd 

 Endwith 

 Endscan 

With wdrs.ActiveDocument.Tables(1).Rows(1).Delete 

.cell(1,1).Borders(-1). LineStyle =0Endwith 

Release wdrs 

=MESSAGEBOX('OK')

word excel.rar(16.63 KB)