📄 qd_worde.pas
字号:
b_break:=True;
break;
end;
ntempcount:=i+2;
if i>0 then
begin
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
if i<gcqdlist.Count-1 then
wdapp.Selection.InsertRowsAbove(ncount);
end;
end; //end for i:=ntempcount to gcqdlist.count-1 do
if b_break then
begin
if Trim(array_jbxx[1])='1' then
begin
wdapp.Selection.Tables.Item(nitem).Cell(nrowcount,ntmpcol).Select;
if nxhheight>=1 then
begin
if nxhheight>=1 then
begin
if nxhheight=1 then
wdapp.Selection.TypeText(strxh)
else if nxhheight>1 then
begin
nunit:=wdLine;
ncount:=nxhheight-1;
nindex:=1;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
if ncount>0 then
wdapp.Selection.Cells.Merge;
wdapp.Selection.TypeText(strxh);
end;
end;
end;
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
end;
end; //end if b_break then
if i>=gcqdlist.Count-1 then
begin
if Trim(array_jbxx[1])='1' then
begin
wdapp.Selection.Tables.Item(nitem).Cell(nrowcount,ntmpcol).Select;
if nxhheight>=1 then
begin
if nxhheight>=1 then
begin
if nxhheight=1 then
wdapp.Selection.TypeText(strxh)
else if nxhheight>1 then
begin
nunit:=wdLine;
ncount:=nxhheight-2;
nindex:=1;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
if ncount>0 then
wdapp.Selection.Cells.Merge;
wdapp.Selection.TypeText(strxh);
end;
end;
end;
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
end;
end;
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
wdapp.Selection.TypeParagraph;
bzxtoword(wddoc,wdapp,mygrid);
end; //end while
wddoc.saveas(word_path);
wddoc.Close;
wdapp.Quit;
except
screen.Cursor:=crdefault;
wddoc.saveas(word_path);
wddoc.Close;
wdapp.Quit;
end; //end try
screen.Cursor:=crdefault;
mainform.statusbar1.Panels[2].Text:='导入Word成功!';
mainform.statusbar1.Update;
application.MessageBox('导入Word成功','温馨提示',mb_iconinformation);
end;
{把其他项目工程量清单报表导到Word文档中}
procedure qtxmqdtoword(mygrid:TStringGrid);
var
i,j,k:integer;
ntopdis,nleftdis,nbottomdis,nrightdis:integer;//报表上,下,左,右边距的值
dy:integer; //报表纸张的宽度和高度
nh,nb:integer; //标题离纸的高度
ntop:integer; //表头离纸的高度
nbottomtop:integer; //纸张表注部分所占的高度
nhheight:integer; //表头边框的高度
rcj:Tjc_rcj;
ntup:integer;
strselectid:string;
ntempcount:integer;
nmin,nmax:integer;
nht:integer;
ncol:integer; //用于本页小计用
b_frist,b_break:boolean;
nxh:integer;
Template,NewTemplate,type1,v1,ItemIndex:OleVariant;
ncount,nunit,nindex,numrow,wdapp,wddoc:OleVariant;
oldpage:OleVariant;
nitem:integer;
ntmppage:integer;
begin
oldpage:=0;
if (getactiveform as Tfrm_ys).TV_js.Selected<>nil then
strselectid:=PData2((getactiveform as Tfrm_ys).TV_js.Selected.Data)^.ID
else
abort;
getxx(strselectid); //取得报表基本信息
setxx(strselectid,mygrid); //给临时的grid赋值
getqtxmqd; //取得其他项目工程量清单
nht:=strtoint(array_jbxx[48]);
ntopdis:=strtoint(array_jbxx[5])*3;
nbottomdis:=strtoint(array_jbxx[7])*3;
nleftdis:=strtoint(array_jbxx[4])*3;
nrightdis:=strtoint(array_jbxx[6])*3;
nhheight:=gethead(mygrid,strtoint(array_jbxx[48]));
if Trim(array_jbxx[8])='1' then
dy:=getpageh(0,True)
else
dy:=getpageh(0,False);
nh:=getup(array_jbxx[26],array_jbxx[27],array_jbxx[28],array_jbxx[29],array_jbxx[30],array_jbxx[31],array_jbxx[32],array_jbxx[33],array_jbxx[34]);
nb:=getup(array_jbxx[35],array_jbxx[38],array_jbxx[41],array_jbxx[36],array_jbxx[39],array_jbxx[42],array_jbxx[37],array_jbxx[40],array_jbxx[43]);
ntop:=ntopdis+60+nh; //表头开始离纸的高度
nbottomtop:=dy-nbottomdis-nb; //作为换页的依据;
ntmppage:=0; ntempcount:=0;
while ntempcount<=qtxmqdlist.Count do
begin
ntup:=ntop+nhheight;
for i:=ntempcount to qtxmqdlist.Count-1 do
begin
nmax:=1;
for j:=1 to mygrid.ColCount-1 do
begin
nmin:=getlinecount(calqtxmqd(i,mygrid,j),mygrid.ColWidths[j]);
if nmin>nmax then
nmax:=nmin;
end; // end for j
if array_jbxx[46]='1' then
begin
if i+1=qtxmqdlist.Count-1 then //创建本页小计 因为记录不够,那就在合计前
begin //创建本页小计了
if array_dyxx[1]='1' then
begin
ntup:=ntup+nht*nmax;
nmax:=1;
end;
end;
end;
ntup:=ntup+nht*nmax;
if ntup+50>nbottomtop then
break;
end;
ntempcount:=i+1;
inc(ntmppage);
end;
npagecount:=ntmppage;
lineword1;
try
wdapp:=CreateOleObject('Word.Application');
except
application.MessageBox(pchar('与Word应用程序连接失败!请确定是否已经装有Word,或者Word应用程序已被破坏!'+#13#10
+'如有必要,请联络程序设计人员!'),'温馨提示',mb_iconexclamation);
screen.Cursor:=crdefault;
Abort;
end;
wdapp.Visible:=True;
try
Template := EmptyParam;
NewTemplate := EmptyParam;
type1 := 1;
v1:= true; ItemIndex :=1;
wddoc:=wdapp.Documents.Add(Template,NewTemplate,type1,v1); //.wordapp.Documents.Item(ItemIndex)
if Trim(array_jbxx[8])='0' then //判断是否是纵向打印
wdapp.Documents.Item(itemindex).PageSetup.Orientation := wdOrientLandscape;// 横向打印
if (ntopdis-65)<0 then
wdapp.Documents.Item(itemindex).PageSetup.TopMargin:=5
else
wdapp.Documents.Item(itemindex).PageSetup.TopMargin:=ntopdis-65;
if (nbottomdis-65)<0 then
wdapp.Documents.Item(itemindex).PageSetup.BottomMargin:=5
else
wdapp.Documents.Item(itemindex).PageSetup.BottomMargin:=nbottomdis-65;
wdapp.Documents.Item(itemindex).PageSetup.LeftMargin:=nleftdis;
wdapp.Documents.Item(itemindex).PageSetup.RightMargin:=nrightdis;
if wdapp.ActiveWindow.View.SplitSpecial= wdPaneNone then
wdapp.ActiveWindow.ActivePane.View.Type:=wdPrintView
else
wdapp.ActiveWindow.View.Type:=wdPrintView;
nxh:=1;
b_frist:=False;
ntempcount:=0; npagetmp:=0;
while ntempcount<=qtxmqdlist.Count do
begin
b_break:=False;
if oldpage<>0 then oldpage:=wdapp.Selection.Information[wdActiveEndAdjustedPageNumber];
while wdapp.Selection.Information[wdActiveEndAdjustedPageNumber]<>oldpage+1 do
wdapp.Selection.TypeParagraph;
for k:=1 to 40 do
array_hj[k]:=0;
oldpage:=1; npagetmp:=npagetmp+1;
bztoword1(wddoc,wdapp,mygrid); //表注部分导到word {这里必须要重写}
bttoword4(mygrid,wddoc,wdapp); //表头部分导到word
ntup:=ntop+nhheight;
for i:=ntempcount to qtxmqdlist.Count-1 do
begin
rcj:=Tjc_rcj(qtxmqdlist.Items[i]);
nmax:=1;
for j:=1 to mygrid.ColCount-1 do
begin
nmin:=getlinecount(calqtxmqd(i,mygrid,j),mygrid.ColWidths[j]);
if nmin>nmax then
nmax:=nmin;
end; // end for j
if Trim(array_jbxx[1])='1' then
begin
wdapp.Selection.TypeText(inttostr(nxh));
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
inc(nxh);
end;
for j:=1 to mygrid.ColCount-1 do
begin
if isnumber(calqtxmqd(i,mygrid,j))=0 then
array_hj[j]:=array_hj[j]+strtofloat(calqtxmqd(i,mygrid,j)); //创建本页小计 合计本页信息
if lowercase(Trim(mygrid.Cells[j,1]))='mc' then
wdapp.Selection.TypeText(calqtxmqd(i,mygrid,j))
else if (Trim(array_jbxx[46])='1') and (Trim(mygrid.Cells[j,4])='') and ((rcj.flag=2) or (rcj.flag=3)) then
wdapp.Selection.TypeText('')
else if i<qtxmqdlist.Count then
wdapp.Selection.TypeText(calqtxmqd(i,mygrid,j));
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
end;
if array_jbxx[46]='1' then
begin
if i+1=gcqdlist.Count-1 then //创建本页小计 因为记录不够,那就在合计前
begin //创建本页小计了
if array_dyxx[1]='1' then
begin
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
wdapp.Selection.InsertRowsAbove(ncount);
b_frist:=True;
ntup:=ntup+nht*nmax;
nmax:=1;
if Trim(array_jbxx[1])='1' then
begin
wdapp.Selection.TypeText('');
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
end;
for ncol:=1 to mygrid.ColCount-1 do
begin
if (lowercase(Trim(mygrid.Cells[ncol,1]))='mc') then
wdapp.Selection.TypeText('本页小计')
else if Trim(mygrid.Cells[ncol,4])='' then
wdapp.Selection.TypeText('')
else if i<qtxmqdlist.Count then
wdapp.Selection.TypeText(Trim(floattostr(array_hj[ncol])));
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
end; // end for ncol
end;
end;
end;
ntup:=ntup+nht*nmax;
if ntup+50>nbottomtop then
begin
b_break:=True;
break;
end;
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
if i<qtxmqdlist.Count-1 then
wdapp.Selection.InsertRowsAbove(ncount);
end; // end for i:=ntempcount
if b_frist=False then
begin
if array_dyxx[1]='1' then
begin
if b_break then
begin
nunit:=wdCharacter;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveRight(nunit,ncount,nindex);
nunit:=wdLine;
ncount:=1;
nindex:=0;
wdapp.Selection.MoveDown(nunit,ncount,nindex);
end;
wdapp.Selection.InsertRowsAbove(ncount);
if Trim(array_jbxx[1])='1' then
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -