這是我做項目過程中自己做的幾個函數，見到大家都在問Word的問題。現在拿出來和大家共享。（希望有朋友可以進一步添加新的功能，或者做成包或者lib等，更方便大家使用。我自己是沒有時間啦，呵呵）
使用前，先根據需要建立一個空的WORD文件作為模板，在模板文件中設置好各種格式和文本。另外，其中的PrnWordTable的參數是TDBGridEh類型的控件，取自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,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.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
Clipboard.Assign(imgInsert.Picture);
wRange.Paste;
end else begin
wRange.InsertAfter('照片');
end;
result:=true;
except
result:=false;
end;
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;
end;
{
功能：保存Word文件
}
procedure PrnWordSave;
begin
try
wDoc.Save;
except
end;
end;
{
功能：關閉Word文件
}
procedure PrnWordEnd;
begin
try
wDoc.Save;
wDoc.Close;
wApp.Quit;
except
end;
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;
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;
