delphi操作word -- 转
转自?http://xxzqb.blog.163.com/blog/static/4122142920089249514506/
?? 开发原因：公司财务要每月与专卖店对帐，其对帐单格式是统一的，只是每月改变其中的数据。
如下图：
所以，我设置了一个模板，名字为 xldzd.dot ，格式如下：
即把每月要修改的数据做成批注。
然后在 d:\对帐单 目录下创建 每月的目录，其名称为日期，如： d:\对帐单\2008-10 。（这部分是由程序产生）
然后，查询数据表（adoquery），
在刚才建立的目录下，产生word文档，上面查询出的数据依次替换 批注，完毕后，删除批注，并且关闭该word文档，然后继续替换，每一个专卖店产生一个word文档，其名称为专卖店的email 。 在电脑中的结果如下图：
?
?
程序的关键语句在 procedure TForm9.Button3Click(Sender: TObject);
?
unit Unit9;
interface
uses
? Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
? Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, DBXpress, SqlExpr, DBTables,
? WordXP, OleServer, ComCtrls;
type
? TForm9 = class(TForm)
??? Button1: TButton;
??? DBGrid1: TDBGrid;
??? DataSource1: TDataSource;
??? ADOConnection1: TADOConnection;
??? ADOQuery1: TADOQuery;
??? WordDocument1: TWordDocument;
??? WordApplication1: TWordApplication;
??? OpenDialog1: TOpenDialog;
??? Button3: TButton;
??? StatusBar1: TStatusBar;
??? ADOConnection2: TADOConnection;
??? ADOQuery2: TADOQuery;
??? procedure Button1Click(Sender: TObject);
??? procedure Button3Click(Sender: TObject);
??? procedure deletecomment();
??? procedure writecomment(explans:array of string);
??? procedure wordini(template:olevariant);
??? procedure setopendialog;
??? procedure substpostils(postils:array of string);
??? procedure deletepostils;
? private
??? { Private declarations }
? public
??? { Public declarations }
? end;
var
? Form9: TForm9;
? ptotal:integer;
implementation
uses Unit10;
{$R *.dfm}
procedure TForm9.deletecomment;
var
?? total:integer;
begin
?? total:=worddocument1.Comments.Count;
?? while total<>0 do
????? begin
?????? worddocument1.comments.item(total).Delete;
?????? total:=worddocument1.comments.Count;
????? end;
end;
procedure TForm9.wordini(template: olevariant);
var
?? newtemplate,itemindex:olevariant;
begin
?? newtemplate:=false;
?? itemindex:=1;
?? try
????? wordapplication1.Connect;
?? except
????? wordapplication1.Disconnect;
????? messagedlg('请安装Office中的Word软件！',mterror,[mbok],0);
????? exit;
?? end;
?? wordapplication1.Visible:=true;
?? wordapplication1.Documents.Add(template,newtemplate,emptyparam,emptyparam);
?? worddocument1.ConnectTo(wordapplication1.Documents.Item(itemindex));
?? ptotal:=worddocument1.Comments.count;
end;
procedure TForm9.writecomment(explans: array of string);
var
??? i,total:integer;
begin
??? total:=worddocument1.Comments.Count;
??? for i:=0 to total do
??????? worddocument1.Comments.item(i).Scope.Text:=explans[i-1]
end;
procedure TForm9.setopendialog;
var
???? pathname,filename:string;
begin
??? //保证选择的文件必须存在
??? opendialog1.Options:=[offilemustexist];
??? opendialog1.filter:='word files(*.dot)|*.dot|all files(*.*)|*.*';
??? //设置*.dot类型为缺省类型
??? opendialog1.FilterIndex:=1;
??? //设置文档模板文件名为缺省值
??? opendialog1.FileName:='xldzd.dot';
??? if not opendialog1.Execute then
??????? exit;
??? pathname:=extractfilepath(opendialog1.FileName);
??? filename:=extractfilename(opendialog1.FileName);
??? if lowercase(copy(filename,length(filename)-4+1,4))<>'.dot' then
??????? begin
??????????? messagedlg('请打开Word模板文件！',mterror,[mbok],0);
??????????? exit;
??????? end;
??? if lowercase(filename)<>'xldzd.dot' then
??????? begin
??????????? messagedlg('请选择正确的Word模板文件！',mterror,[mbok],0);
??????????? exit;
??????? end;
end;
procedure TForm9.substpostils(postils: array of string);
var
?? i:integer;
begin
?? //逐个替换批注
?? for i:=1 to ptotal do
????? begin
????????? worddocument1.Comments.Item(i).Scope.Text:=postils[i-1];
????? end;
end;
procedure TForm9.deletepostils;
var
??? total:integer;
begin
??? total:=ptotal;
??? while total<>0 do
??????? begin
??????????? //删除文档中的一个批注
??????????? worddocument1.comments.Item(total).Delete;
??????????? //获得文档中的剩余批注总数
??????????? total:=worddocument1.Comments.Count;
??????? end;
end;
procedure TForm9.Button1Click(Sender: TObject);
begin
//查询富友中的数据（太慢）
?with adoquery2 do
??????? begin
??????????? close;
??????????? sql.clear;
??????????? sql.add('select kcckdm,sum(kcqcje),sum(kcrkje),sum(kcckje) from kct06');
??????????? sql.add('where kckjnd=2008 and kckjyf=8');
??????????? sql.Add('group by kcckdm');
??????????? sql.add('order by kcckdm');
??????????? open;
?
??????????? //下面代码没问题
??????????? {close;
??????????? sql.clear;
??????????? sql.add('select * from ylm03');
??????????? open; }
??????? end;
?
end;
procedure TForm9.Button3Click(Sender: TObject);
var
??? postils:array of string;
??? //y,m,d:word;
??? pathname,filename:string;
??? savedocfile,emptypara:olevariant;
//这些都是目录名称
??? dir:string;
???
??? currdir:string;
??? dirname:string;
??? curr_dir:string;
begin
?? //先建立文件夹 (放在d:\对帐单\下)
??? //先判断文件夹是否已存在 ， 不存在，就创建之
??? if not directoryexists('d:\对帐单') then
?????????? begin
????????????? try
?????????????? //创建文件夹
?????????????? mkdir('d:\对帐单');
?????????????? statusbar1.Panels[2].Text:='? ① d:\对帐单 目录创建成功！';
????????????? except
?????????????? statusbar1.Panels[2].Text:='? ③ d:\对帐单 目录无法创建！';;
?????????????? exit;
????????????? end;
?????????? end else
?????????? begin
?????????????? statusbar1.Panels[2].Text:='? ② d:\对帐单 目录已经存在！';
??????????????
?????????? end;
?
??? //把日期当前日期当作新建文件夹的名称
???? dir:=formatdatetime('yyyy-mm',date);
????
???? try
???????? //改变当前文件夹为 d:\对帐单
???????? chdir('d:\对帐单');
???????? //取得当前文件夹，赋值给变量 currdir
???????? getdir(0,currdir);
???????? statusbar1.Panels[2].Text:='? ④ 当前目录为：'+currdir;
???? except
???? end;
???? //在文件夹 d:\对帐单 下根据日期创建文件夹，文件夹名为日期
???? if not directoryexists('d:\对帐单\'+dir) then
?????????? begin
????????????? try
?????????????? //创建文件夹
?????????????? mkdir('d:\对帐单\'+dir);
?????????????? statusbar1.Panels[2].Text:='? ⑤ d:\对帐单\'+dir+' 目录创建成功！';
????????????? except
?????????????? statusbar1.Panels[2].Text:='? ⑥ d:\对帐单\'+dir+' 目录无法创建！';;
?????????????? exit;
????????????? end;
?????????? end else
?????????? begin
?????????????? statusbar1.Panels[2].Text:='? ⑦ d:\对帐单\'+dir+' 目录已经存在！';
?????????????? //exit;
?????????? end;
???? //转换当前文件夹至 d:\对帐单\日期
???? try
???????? //改变当前文件夹为 d:\对帐单\日期
???????? chdir('d:\对帐单\'+dir);
???????? //取得当前文件夹，赋值给变量 curr_dir
???????? getdir(0,curr_dir);
???????? statusbar1.Panels[2].Text:='? ⑧ 当前目录为：'+curr_dir;
???? except
???? end;
???? //------------------------
?
?
??? //setopendialog;
??? //保证选择的文件必须存在
??? opendialog1.Options:=[offilemustexist];
??? opendialog1.filter:='Word Files(*.dot)|*.dot|All Files(*.*)|*.*';
??? //设置*.dot类型为缺省类型
??? opendialog1.FilterIndex:=1;
??? //设置文档模板文件名为缺省值
??? opendialog1.FileName:='xldzd.dot';
??? //如果打开对话框没有运行，就退出
??? if not opendialog1.Execute then
??????? exit;
??? //赋文件名
??? pathname:=extractfilepath(opendialog1.FileName);
??? filename:=extractfilename(opendialog1.FileName);
??? if lowercase(copy(filename,length(filename)-4+1,4))<>'.dot' then
??????? begin
??????????? messagedlg('请打开Word模板文件！',mterror,[mbok],0);
??????????? exit;
??????? end;
??? if lowercase(filename)<>'xldzd.dot' then
??????? begin
??????????? messagedlg('请选择正确的Word模板文件！',mterror,[mbok],0);
??????????? exit;
??????? end;
?
???? //查询出要插入的数据表数据
???? with adoquery1 do
??????? begin
??????????? close;
??????????? sql.clear;
??????????? sql.add('select * from xldzd');
??????????? open;
??????????? first;
??????????? //赋值给批注
??????????? while not adoquery1.Eof do
??????????????? begin
??????????????????????? wordini(pathname+filename);
??????????????????????? setlength(postils,ptotal);
??????????????????????? postils[0]:=trim(fieldbyname('t1').asstring);
??????????????????????? postils[1]:=trim(fieldbyname('t2').asstring);
??????????????????????? postils[2]:=trim(fieldbyname('t3').asstring);
??????????????????????? postils[3]:=trim(fieldbyname('t4').asstring);
??????????????????????? postils[4]:=trim(fieldbyname('a1').asstring);
??????????????????????? postils[5]:=trim(fieldbyname('a2').asstring);
??????????????????????? postils[6]:=trim(fieldbyname('a3').asstring);
??????????????????????? postils[7]:=trim(fieldbyname('a4').asstring);
??????????????????????? postils[8]:=trim(fieldbyname('a5').asstring);
??????????????????????? postils[9]:=trim(fieldbyname('b1').asstring);
??????????????????????? postils[10]:=trim(fieldbyname('b2').asstring);
??????????????????????? postils[11]:=trim(fieldbyname('b3').asstring);
??????????????????????? postils[12]:=trim(fieldbyname('b4').asstring);
??????????????????????? postils[13]:=trim(fieldbyname('b5').asstring);
??????????????????????? //填充批注
??????????????????????? substpostils(postils);
??????????????????????? //删除批注
??????????????????????? deletepostils;
??????????????????????? //保存目录及文件 ，文件名为 email.doc
??????????????????????? savedocfile:=curr_dir+'\'+fieldbyname('email').asstring+'.doc';
??????????????????????? emptypara:=emptyparam;
??????????????????????? //保存文档
??????????????????????? worddocument1.SaveAs(savedocfile,emptypara);
??????????????????????? //关闭该文档
??????????????????????? worddocument1.Close;
??????????????????????? next;
??????????????? end;
??????? end;
??????? statusbar1.Panels[3].Text:='? 对帐单已全部保存完毕！';
??????? //最后关闭word
??????? wordapplication1.Disconnect;
end;
end.
