标题:如何用VFP代码控制WORD每页打印25条记录
只看楼主
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
得分:0 
@xuminxz 说错了,不好意思。WORD模板文件连标题共4行(见1楼),我想生成的WORD文档每页都有标题行,且每页20条记录,如何操作呢?盼指点。
2021-05-25 17:45
xuminxz
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:40
帖 子:749
专家分:2475
注 册:2011-5-8
得分:20 
这是每页20行数据,25行可以自己改


程序代码:
* VFP调用WORD模板文件生成多页WORD文档
* 设置"标题行重复":打开新生成的WORD文档,选中标题行[color=#808080]->单击表格->单击标题行重复[/color]

Close Tables All
Set Talk Off
Set Safety Off
Set Date To YMD
Set Mark To "-"
Set Century On
Set Compatible Off
Use gp
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)+"\股票信息统计表模板.doc"
_Onm=Sys(5)+Sys(2003)+"\股票信息统计表.doc"

Declare Long SetForegroundWindow In user32.Dll Long &&设置顶层窗口
Declare Long FindWindow In WIN32API String lpClassName,String lpWindowName  &&第一个参数写 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)

**增加空行,使总数等于20
**代码自己写吧但建议直接在模板文件中设置好
**
yms=CEILING(Reccount()/20)  &&不能用int ,会丢掉数据。
wdrs.Selection.WholeStory()
wdrs.Selection.Cut()  &&复制到粘贴板备用
Go Top
For i=0 To yms-1
    j=3
    wdrs.Selection.EndKey(6) &&将光标移动到文档尾
    wdrs.Selection.pasteandformat(19)  &&粘贴模板
    wdrs.Selection.InsertBreak(7)   &&插入分页符
    Do While !Eof() And j<23
        wdrs.activedocument.Tables(i+1).Cell(j,1).Range.Text=Evaluate(Field(1))
        wdrs.activedocument.Tables(i+1).Cell(j,2).Range.Text=Evaluate(Field(2))
        wdrs.activedocument.Tables(i+1).Cell(j,3).Range.Text=Evaluate(Field(3))
        wdrs.activedocument.Tables(i+1).Cell(j,4).Range.Text=Evaluate(Field(4))
        wdrs.activedocument.Tables(i+1).Cell(j,5).Range.Text=Evaluate(Field(5))
        wdrs.activedocument.Tables(i+1).Cell(j,6).Range.Text=Evaluate(Field(6))
        wdrs.activedocument.Tables(i+1).Cell(j,7).Range.Text=Evaluate(Field(7))
        wdrs.activedocument.Tables(i+1).Cell(j,8).Range.Text=Evaluate(Field(8))
        wdrs.activedocument.Tables(i+1).Cell(j,9).Range.Text=Evaluate(Field(9))
        wdrs.activedocument.Tables(i+1).Cell(j,10).Range.Text=Evaluate(Field(10))
        wdrs.activedocument.Tables(i+1).Cell(j,11).Range.Text=Evaluate(Field(11))
        wdrs.activedocument.Tables(i+1).Cell(j,12).Range.Text=Evaluate(Field(12))
        wdrs.activedocument.Tables(i+1).Cell(j,13).Range.Text=Evaluate(Field(13))
        wdrs.activedocument.Tables(i+1).Cell(j,14).Range.Text=Evaluate(Field(14))
        wdrs.activedocument.Tables(i+1).Cell(j,15).Range.Text=Evaluate(Field(15))
        wdrs.activedocument.Tables(i+1).Cell(j,16).Range.Text=Evaluate(Field(16))
        j=j+1
        Skip
    Endd
Endfor



wdrs.ActiveDocument.PageSetup.FooterDistance=19.0*2.835   &&页脚位置
*wdrs.ActiveDocument.PageSetup.Footer.fontsize=12
*mydate=subst(dtos(date()),1,4)+"年"+subst(dtos(date()),5,2)+;
*"月"+subst(dtos(date()),7,2)+"日"
*wdrs.Documents(1).Sections(1).Headers(1).Range.Text="制表日期: ;
*"+mydate+" "         &&页
wdrs.Documents(1).Sections(1).Headers(1).Range.Paragraphs.Alignment=2            && 页眉右齐
wdrs.Documents(1).Sections(1).Footers(1).Range.Paragraphs.Alignment=1            && 页脚居中
wdrs.Documents(1).Sections(1).Footers(1).Range.Select
wdrs.Selection.Font.Size=12
wdrs.Selection.InsertAfter("第")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertFormula("PAGE")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertBefore("页/共")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertFormula("NUMPAGES")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertBefore("页")
wdrs.Documents(1).Save &&自动保存文件
Release wdrs
Wait Clear
Messagebox( "生成Word文件完毕,文件位置 "+onm,64,"完毕")
Return




[此贴子已经被作者于2021-5-25 21:08编辑过]


dBase有人接盘了。
2021-05-25 21:03
王咸美
Rank: 1
等 级:新手上路
帖 子:569
专家分:0
注 册:2018-1-4
得分:0 
@xuminxz 非常感谢耐心指导!!!美中不足的是最后插入了一页空白页。
2021-05-26 07:33
xuminxz
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:40
帖 子:749
专家分:2475
注 册:2011-5-8
得分:0 
* VFP调用WORD模板文件生成多页WORD文档
* 设置"标题行重复":打开新生成的WORD文档,选中标题行->单击表格->单击标题行重复

Close Tables All
Set Talk Off
Set Safety Off
Set Date To YMD
Set Mark To "-"
Set Century On
Set Compatible Off
Use gp
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)+"\股票信息统计表模板.doc"
_Onm=Sys(5)+Sys(2003)+"\股票信息统计表.doc"

Declare Long SetForegroundWindow In user32.Dll Long &&设置顶层窗口
Declare Long FindWindow In WIN32API String lpClassName,String lpWindowName  &&第一个参数写 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)

**增加空行,使总数等于20
**代码自己写吧但建议直接在模板文件中设置好
**
yms=CEILING(Reccount()/20)
wdrs.Selection.WholeStory()
wdrs.Selection.Cut()  &&复制到粘贴板备用
Go Top
For i=0 To yms-1
    j=3
    wdrs.Selection.InsertBreak(7)   &&插入分页符 提前了2行,这样空白页在第一页
    wdrs.Selection.EndKey(6) &&将光标移动到文档尾
    wdrs.Selection.pasteandformat(19)  &&粘贴模板
    Do While !Eof() And j<23
        wdrs.activedocument.Tables(i+1).Cell(j,1).Range.Text=Evaluate(Field(1))
        wdrs.activedocument.Tables(i+1).Cell(j,2).Range.Text=Evaluate(Field(2))
        wdrs.activedocument.Tables(i+1).Cell(j,3).Range.Text=Evaluate(Field(3))
        wdrs.activedocument.Tables(i+1).Cell(j,4).Range.Text=Evaluate(Field(4))
        wdrs.activedocument.Tables(i+1).Cell(j,5).Range.Text=Evaluate(Field(5))
        wdrs.activedocument.Tables(i+1).Cell(j,6).Range.Text=Evaluate(Field(6))
        wdrs.activedocument.Tables(i+1).Cell(j,7).Range.Text=Evaluate(Field(7))
        wdrs.activedocument.Tables(i+1).Cell(j,8).Range.Text=Evaluate(Field(8))
        wdrs.activedocument.Tables(i+1).Cell(j,9).Range.Text=Evaluate(Field(9))
        wdrs.activedocument.Tables(i+1).Cell(j,10).Range.Text=Evaluate(Field(10))
        wdrs.activedocument.Tables(i+1).Cell(j,11).Range.Text=Evaluate(Field(11))
        wdrs.activedocument.Tables(i+1).Cell(j,12).Range.Text=Evaluate(Field(12))
        wdrs.activedocument.Tables(i+1).Cell(j,13).Range.Text=Evaluate(Field(13))
        wdrs.activedocument.Tables(i+1).Cell(j,14).Range.Text=Evaluate(Field(14))
        wdrs.activedocument.Tables(i+1).Cell(j,15).Range.Text=Evaluate(Field(15))
        wdrs.activedocument.Tables(i+1).Cell(j,16).Range.Text=Evaluate(Field(16))
        j=j+1
        Skip
    Endd
Endfor



wdrs.ActiveDocument.PageSetup.FooterDistance=19.0*2.835   &&页脚位置
*wdrs.ActiveDocument.PageSetup.Footer.fontsize=12
*mydate=subst(dtos(date()),1,4)+"年"+subst(dtos(date()),5,2)+;
*"月"+subst(dtos(date()),7,2)+"日"
*wdrs.Documents(1).Sections(1).Headers(1).Range.Text="制表日期: ;
*"+mydate+" "         &&页
wdrs.Documents(1).Sections(1).Headers(1).Range.Paragraphs.Alignment=2            && 页眉右齐
wdrs.Documents(1).Sections(1).Footers(1).Range.Paragraphs.Alignment=1            && 页脚居中
wdrs.Documents(1).Sections(1).Footers(1).Range.Select
wdrs.Selection.Font.Size=12
wdrs.Selection.InsertAfter("第")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertFormula("PAGE")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertBefore("页/共")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertFormula("NUMPAGES")
wdrs.Selection.Start =wdrs.Selection.End
wdrs.Selection.InsertBefore("页")
wdrs.ActiveDocument.Range(0,1).Delete&&删除第一个空白页
wdrs.Documents(1).Save &&自动保存文件
Release wdrs
Wait Clear
Messagebox( "生成Word文件完毕,文件位置 "+_onm,64,"完毕")
Return


[此贴子已经被作者于2021-5-26 08:10编辑过]


dBase有人接盘了。
2021-05-26 08:07



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




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

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