zoukankan      html  css  js  c++  java
  • delphi ole word


    源代码如下:

     

    //Word打印(声明部分)

     

        wDoc,wApp:Variant;

        function PrnWordBegin(tempDoc,docName:String):boolean;

        function PrnWordReplace(docText,newText:String;bSimpleReplace:boolean=false):boolean;

        function PrnWordInsert(lineText:String;bNewLine:boolean=true):boolean;overload;

        function PrnWordInsert(var imgInsert:TImage;sBookMark:String=''):boolean;overload;

        function PrnWordInsert(var chartInsert:TChart;sBookMark:String=''):boolean;overload;

        function PrnWordTable(var dbG:TDBGridEh;sBookMark:String=''):boolean;

        procedure PrnWordSave;

        procedure PrnWordEnd;

     

    //Word打印(实现部分)

     

    {

    功能:基于模板文件tempDoc新建目标文件docName并打开文件

    }

    function PrnWordBegin(tempDoc,docName:String):boolean;

    begin

      result:=false;

      //复制模版

      if tempDoc<>'' then

        if not shFileCopy(tempDoc,docName) then exit;

      //连接Word

      try

        wApp:=CreateOleObject('Word.Application');

      except

        guiInfo('请先安装 Microsoft Word 。');

        exit;

      end;

      try

        //打开

        if tempDoc='' then

        begin

          //创建新文档

          wDoc:=wApp.Document.Add;

          wDoc.SaveAs(docName);

        end else begin

          //打开模版

          wDoc:=wApp.Documents.Open(docName);

        end;

      except

        guiInfo('打开模版失败,请检查模版是否正确。');

        wApp.Quit;

        exit;

      end;

      wApp.Visible:=true;

      result:=true;

    end;

     

    {

    功能:使用newText替换docText内容

    bSimpleReplace:true时仅做简单的替换,false时对新文本进行换行处理

    }

    function PrnWordReplace(docText,newText:String;bSimpleReplace:boolean=false):boolean;

    var i:Integer;

    begin

      if bSimpleReplace then

      begin

        //简单处理,直接执行替换操作

      try

        wApp.Selection.Find.ClearFormatting;

        wApp.Selection.Find.Replacement.ClearFormatting;

        wApp.Selection.Find.Text := docText;

        wApp.Selection.Find.Replacement.Text :=newText;

        wApp.Selection.Find.Forward := True;

        wApp.Selection.Find.Wrap := wdFindContinue;

        wApp.Selection.Find.Format := False;

        wApp.Selection.Find.MatchCase := False;

        wApp.Selection.Find.MatchWholeWord := true;

        wApp.Selection.Find.MatchByte := True;

        wApp.Selection.Find.MatchWildcards := False;

        wApp.Selection.Find.MatchSoundsLike := False;

        wApp.Selection.Find.MatchAllWordForms := False;

        wApp.Selection.Find.Execute(Replace:=wdReplaceAll);

        result:=true;

      except

        result:=false;

      end;

        exit;

      end;

      //自动分行

      reWord.Lines.Clear;

      reWord.Lines.Add(newText);

      try

        //定位到要替换的位置的后面

        wApp.Selection.Find.ClearFormatting;

        wApp.Selection.Find.Text := docText;

        wApp.Selection.Find.Replacement.Text := '';

        wApp.Selection.Find.Forward := True;

        wApp.Selection.Find.Wrap := wdFindContinue;

        wApp.Selection.Find.Format := False;

        wApp.Selection.Find.MatchCase := False;

        wApp.Selection.Find.MatchWholeWord := False;

        wApp.Selection.Find.MatchByte := True;

        wApp.Selection.Find.MatchWildcards := False;

        wApp.Selection.Find.MatchSoundsLike := False;

        wApp.Selection.Find.MatchAllWordForms := False;

        wApp.Selection.Find.Execute;

        wApp.Selection.MoveRight(wdCharacter,1);

        //开始逐行插入

        for i:=0 to reWord.Lines.Count-1 Do

        begin

          //插入当前行

          wApp.Selection.InsertAfter(reWord.Lines[i]);

          //除最后一行外,自动加入新行

          if i<reWord.Lines.Count-1 then

            wApp.Selection.InsertAfter(#13);

        end;

        //删除替换位标

        wApp.Selection.Find.ClearFormatting;

        wApp.Selection.Find.Replacement.ClearFormatting;

        wApp.Selection.Find.Text := docText;

        wApp.Selection.Find.Replacement.Text := '';

        wApp.Selection.Find.Forward := True;

        wApp.Selection.Find.Wrap := wdFindContinue;

        wApp.Selection.Find.Format := False;

        wApp.Selection.Find.MatchCase := False;

        wApp.Selection.Find.MatchWholeWord := true;

        wApp.Selection.Find.MatchByte := True;

        wApp.Selection.Find.MatchWildcards := False;

        wApp.Selection.Find.MatchSoundsLike := False;

        wApp.Selection.Find.MatchAllWordForms := False;

        wApp.Selection.Find.Execute(Replace:=wdReplaceAll);

        result:=true;

      except

        result:=false;

      end;

    end;

    数据导入WORD实现:
    procedure TForm1.Button1Click(Sender: TObject);
    var
      WordApp,WordDoc,WordTable:OleVariant;
      i,j:integer;
    begin
      WordApp:=CreateOleObject('Word.Application');
      WordApp.Visible:=True;
      WordDoc:=WordApp.Documents.Add;
      WordTable:=WordDoc.Tables.Add(WordApp.Selection.Range,DBGrid1.DataSource.DataSet.RecordCount+1,DBGrid1.Columns.Count);
      for i:=1 to DBGrid1.Columns.Count do
      WordTable.Cell(1,i).Range.InsertAfter(DBGrid1.Columns[i-1].Title.Caption);
      i:=2;
      with DBGrid1.DataSource.DataSet do
      while not eof do
      begin
        for j:=1 to DBGrid1.Columns.Count do
          WordTable.Cell(i,j).Range.InsertAfter(DBGrid1.Columns[j-1].Field.Value);
        Next;
        Inc(i);
      end;
    end;

    //设置表格

    wApp := CreateOleobject('word.application');
         wApp.visible :=true;
         wDoc := wApp.Documents.Open     
         wTable:=wDoc.Tables.Add(wApp.Selection.Range,16,7);
         wApp.Selection.Columns.SetWidth(15,True);
         wApp.Selection.MoveRight;
         wApp.Selection.Columns.SetWidth(200,True);
         wApp.Selection.MoveRight;

  • 相关阅读:
    CentOS 8配置Java环境
    记录一个免费的开源API接口管理工具
    WebAPI 查询lookup字段的属性
    Windows环境变量配置与读取
    The specified Active Directory user already exists as a Dynamics 365 user
    QueryExpression之GreaterEqual和LessEqual
    Dynamics CRM Plugin Use Config
    【转】Reports SPN/SSPI Problems
    【转】Report Server cannot load the TERADATA / SQLPDW extension
    iOS 自动布局
  • 原文地址:https://www.cnblogs.com/zhangzhifeng/p/5249580.html
Copyright © 2011-2022 走看看