Delphi＋Word解決方案參考 (轉)[@more@]

＋解決方案參考:namespace prefix = o ns = "urn:schemas--com::office" />

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

使用前，先根據需要建立一個空的WORD作為模板，在模板檔案中設定好各種格式和文字。另外，其中的PrnWordTable的引數是TGrh型別的，取自Ehlib2.6

其中用到的shFileCopy函式（用於複製檔案）和guiInfo函式（用於顯示訊息框）也是自己編寫的，程式碼也附後。

示範程式碼如下：

程式碼完成的功能：

1. 替換列印模板中的“#TITLE#”文字為“示範程式碼1”

2. 並且將DBGridEh1控制元件當前顯示的內容插入到文件的末尾

3. 在文件末尾插入一個空行

4. 在文件末尾插入新的一行文字

5. 將文件中的空行去掉

if PrnWordBegin('C:列印模板.DOC','C:目標檔案1.DOC') then

begin

PrnWordReplace('#TITLE#','示範程式碼1');

PrnWordTable(DBGridEh1);

PrnWordInsert('');

PrnWordInsert('這是新的一行文字');

PrnWordReplace('^p^p','^p',true);

PrnWordSave;

end;

如下：

//Word列印（宣告部分）

wDoc,p:Variant;

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

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

function PrnWordInsert(lext: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:=CreateOle('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.ion.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

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;

{

功能：列印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;

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

if dbG.Data.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;

//填寫每一行

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;

//設定單元格對齊方式

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;

dbG.DataSource.DataSet.Next;

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;

//處理多行標題

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;

lastTitle:=titleList.Strings[0];

lastTitleSplit:=titleList.Count;

titleList.Clear;titleList.Free;

k:=k+1;

end;

//自動調整表格

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

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

result:=true;

except

result:=false;

end;

try

dbG.DataSource.dataset.EnableControls;

except

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

wDoc.Range.InsertAfter(#13);

end;

result:=true;

except

result:=false;

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

Clipboard.Assign(imgInsert.Picture);

wRange.Paste;

end else begin

wRange.InsertAfter('照片');

end;

result:=true;

except

result:=false;

end;

{

功能：在書籤sBookMark處插入TChart控制元件包含的圖表

}

function PrnWordInsert(var chartInsert:TChart;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;

chartInsert.CopyToClipboardBitmap;

wRange.Paste;

result:=true;

except

result:=false;

end;

{

功能：儲存Word檔案

}

procedure PrnWordSave;

begin

try

wDoc.Save;

except

end;

{

功能：關閉Word檔案

}

procedure PrnWordEnd;

begin

try

wDoc.Save;

wDoc.Close;

wApp.Quit;

except

end;

附：shFileCopy原始碼

{

功能：的複製檔案

srcFile，destFile：原始檔和目標檔案

bDelDest：如果目標檔案已經存在，是否覆蓋

返回值：true成功，false失敗

}

function shFileCopy(srcFile,destFile:String;bDelDest:boolean=true):boolean;

begin

result:=false;

if not FileExists(srcFile) then

begin

guiInfo ('原始檔不存在，不能複製。'+#10#13+srcFile);

exit;

end;

if srcFile=destFile then

begin

guiInfo ('原始檔和目標檔案相同，不能複製。');

exit;

end;

if FileExists(destFile) then

begin

if not bDelDest then

begin

guiInfo ('目標檔案已經存在，不能複製。'+#10#13+destFile);

exit;

end;

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

if not DeleteFile(PChar(destFile)) then

begin

guiInfo ('目標檔案已經存在，並且不能被刪除，複製失敗。'+#10#13+destFile);

exit;

end;

if not CopyFileTo(srcFile,destFile) then

begin

guiInfo ('發生未知的錯誤，複製檔案失敗。');

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;

Delphi＋Word解決方案參考 (轉)

相關文章