Delphi＋Word解決方案參考

2019-11-18 18:27:09

字體：大中小

來源：轉載

供稿：網友

[轉]這是我做項目過程中自己做的幾個函數，見到大家都在問Word的問題。現在拿出來和大家共享。（希望有朋友可以進一步添加新的功能，或者做成包或者lib等，更方便大家使用。我自己是沒有時間啦，呵呵）

使用前，先根據需要建立一個空的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.document．.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;

{

功能：打印TDBGridEh當前顯示的內容

基于TDBGridEh控件的格式和內容，自動在文檔中的sBookMark書簽處生成Word表格

目前能夠支持單元格對齊、多行標題（兩行）、底部合計等特性

sBookMark：Word中要插入表格的書簽名稱

}

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

var iCol,iLine,i,j,k:Integer;

    wTable,wRange:Variant;

    iRangeEnd:longint;

    iGridLine,iTitleLine:Integer;

    getTextText:String;getTextDisplay:boolean;

    titleList:TStringList;titleSplit,titleCol:Integer;lastTitleSplit,SubTitle:Integer;lastTitle:String;

begin

  result:=false;

  try

    //計算表格的列數（不包括隱藏的列）

    iTitleLine:=1;  //始終默認為1

    iCol:=0;

    for i:=0 to dbG.Columns.Count-1 Do

    begin

      if dbG.Columns[i].Visible then

      begin

        iCol:=iCol+1;

      end;

    end;

    //計算表格的行數（不包括隱藏的列）

    if dbG.DataSource.DataSet.Active then

      iLine:=dbG.DataSource.DataSet.RecordCount

    else

      iLine:=0;

    iGridLine:=iLine+iTitleLine+dbG.FooterRowCount;

    //定位插入點

    if sBookMark='' then

    begin

      //在文檔末尾

      iRangeEnd:=wDoc.Range.End-1;

      if iRangeEnd<0 then iRangeEnd:=0;

      wRange:=wDoc.Range(iRangeEnd,iRangeEnd);

    end else begin

      //在書簽處

      wRange:=wDoc.Range.Goto(wdGoToBookmark,,,sBookMark);

    end;

    wTable:=wDoc.Tables.Add(wRange,iGridLine,iCol);

    wTable.Columns.AutoFit;

    //標題行

    k:=1;

    for j:=1 to dbG.Columns.Count Do

    begin

      if dbG.Columns[j-1].Visible then

      begin

        if dbG.UseMultiTitle then

        begin

          titleList:=strSplit(dbG.Columns[j-1].Title.Caption,'|');

          wTable.Cell(1,k).Range.InsertAfter(titleList.Strings[0]);

        end else

          wTable.Cell(1,k).Range.InsertAfter(dbG.Columns[j-1].Title.Caption);

        //設置單元格對齊方式

        if dbG.Columns[j-1].Title.Alignment=taCenter then

          wTable.Cell(1,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter

        else if dbG.Columns[j-1].Title.Alignment=taRightJustify then

          wTable.Cell(1,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight

        else if dbG.Columns[j-1].Title.Alignment=taLeftJustify then

          wTable.Cell(1,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;

        k:=k+1;

      end;

    end;

    //填寫每一行

    if iLine>0 then

    begin

      dbG.DataSource.dataset.DisableControls;

      dbG.DataSource.DataSet.First;

      for i:=1 to iLine Do

      begin

        k:=1;

        for j:=1 to dbG.Columns.Count Do

        begin

          if dbG.Columns[j-1].Visible then

          begin

            if dbG.Columns[j-1].FieldName<>'' then //避免由于空列而出錯

            begin

              //如果該列有自己的格式化顯示函數，則調用顯示函數獲取顯示串

              getTextText:='';

              if Assigned(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName).OnGetText) then

              begin

                dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName).OnGetText(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName),getTextText,getTextDisplay);

                wTable.Cell(i+iTitleLine,k).Range.InsertAfter(getTextText);

              end else begin

                //使用數據庫內容顯示

                wTable.Cell(i+iTitleLine,k).Range.InsertAfter(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName).AsString);

              end;

            end;

            //設置單元格對齊方式

            if dbG.Columns[j-1].Alignment=taCenter then

              wTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter

            else if dbG.Columns[j-1].Alignment=taRightJustify then

              wTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight

            else if dbG.Columns[j-1].Alignment=taLeftJustify then

              wTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;

            k:=k+1;

          end;

        end;

        dbG.DataSource.DataSet.Next;

      end;

    end;

    //結尾行

    for i:=1 to dbG.FooterRowCount Do

    begin

      k:=1;

      for j:=1 to dbG.Columns.Count Do

      begin

        if dbG.Columns[j-1].Visible then

        begin

          wTable.Cell(iLine+1+i,k).Range.InsertAfter(dbG.GetFootervalue(i-1,dbG.Columns[j-1]));

          //設置單元格對齊方式

          if dbG.Columns[j-1].Footer.Alignment=taCenter then

            wTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter

          else if dbG.Columns[j-1].Footer.Alignment=taRightJustify then

            wTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight

          else if dbG.Columns[j-1].Footer.Alignment=taLeftJustify then

            wTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;

          k:=k+1;

        end;

      end;

    end;

    //處理多行標題

    if dbG.UseMultiTitle then

    begin

      //先分割單元格，再逐個填入第二行

      k:=1;

      titleCol:=1;

      lastTitleSplit:=1;

      SubTitle:=0;

      lastTitle:='';

      for j:=1 to dbG.Columns.Count Do

      begin

        if dbG.Columns[j-1].Visible then

        begin

          titleList:=strSplit(dbG.Columns[j-1].Title.Caption,'|');

          if titleList.Count>1 then

          begin

            //處理第二行以上的內容

            wTable.Cell(1,k-SubTitle).Range.Cells.Split(titleList.Count,1,false);

            for titleSplit:=1 to titleList.Count-1 Do

            begin

              wTable.Cell(titleSplit+1,titleCol).Range.InsertAfter(titleList.Strings[titleSplit]);

            end;

            titleCol:=titleCol+1;

            //處理第一行合并

            if (lastTitleSplit=titleList.Count) and (lastTitle=titleList.Strings[0]) then

            begin

              //內容相同時，合并單元格

              wTable.Cell(1,k-SubTitle).Range.Copy;

              wRange:=wDoc.Range(wTable.Cell(1,k-SubTitle-1).Range.Start,wTable.Cell(1,k-SubTitle).Range.End);

              wRange.Cells.Merge;

              wRange.Paste;

              SubTitle:=SubTitle+1;

            end;

          end;

          lastTitle:=titleList.Strings[0];

          lastTitleSplit:=titleList.Count;

          titleList.Clear;titleList.Free;

          k:=k+1;

        end;

      end;

    end;

    //自動調整表格

    wTable.AutoFitBehavior(1);//根據內容自動調整表格wdAutoFitContent

    wTable.AutoFitBehavior(2);//根據窗口自動調整表格wdAutoFitWindow

    result:=true;

  except

    result:=false;

  end;

  try

    dbG.DataSource.dataset.EnableControls;

  except

  end;

end;

{

功能：在Word文件中插入文本（能夠自動進行換行處理）

lineText：要插入的文本

bNewLine：true時新起一行，false時在當前行插入

}

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

var i:Integer;

begin

  try

    if bNewLine then

      wDoc.Range.InsertAfter(#13);

    //自動分行

    reWord.Lines.Clear;

    reWord.Lines.Add(lineText);

    //開始逐行插入

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

    begin

      //插入當前行

      wDoc.Range.InsertAfter(reWord.Lines[i]);

      //除最后一行外，自動加入新行

      if i<reWord.Lines.Count-1 then

        wDoc.Range.InsertAfter(#13);

    end;

    result:=true;

  except

    result:=false;

  end;

end;

{

功能：在Word文件的sBookMark書簽處插入TImage控件包含的圖片

}

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

var wRange:Variant;iRangeEnd:Integer;

begin

  try

    if sBookMark='' then

    begin

      //在文檔末尾

      iRangeEnd:=wDoc.Range.End-1;

      if iRangeEnd<0 then iRangeEnd:=0;

      wRange:=wDoc.Range(iRangeEnd,iRangeEnd);

    end else begin

      //在書簽處

      wRange:=wDoc.Range.Goto(wdGoToBookmark,,,sBookMark);

    end;

    if imgInsert.Picture.Graphic<>nil then

    begin

      Cl
    exit;

  end;

  //目標文件去掉只讀屬性

  FileSetAttr(destFile,FileGetAttr(destFile) and not $00000001);

  result:=true;

end;

附：guiInfo源代碼

{

功能：封裝了各種性質的提示框

sMsg：要提示的消息

}

procedure guiInfo(sMsg:String);

begin

  MessageDlg(sMsg,mtInformation,[mbOK],0);

end;