//使用前，先根据需要建立一个空的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.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);
//除最后一行外，自动加入新行
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.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);
//除最后一行外，自动加入新行
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;
这个别人的资料，你参考一下吧
