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.