转贴
{功能：打印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(wdGoToBook,,,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;
vTable := wordApp.ActiveDocument.Tables.Item(j);
WordDocument1.ConnectTo(WordApp.Documents.Item(ItemIndex));
vTable.Select;
WordApp.Selection.Copy;
worddocument1.Range.InsertAfter(''+#13);
rend:=worddocument1.Range.End_-1;
myrange:=WordDocument1.Range(rend,rend);
if j<rs.RecordCount then myrange.Paste;
// CopyTable:=
vTable.Cell(1, 2).Range.Text := rs.FieldByName('from').Text;;
vTable.Cell(1, 4).Range.Text := datetostr(rs.FieldByName('inputdate').Value);
vTable.Cell(2, 2).Range.Text := rs.FieldByName('author').Text;
vTable.Cell(2, 4).Range.Text := rs.FieldByName('translation').Text;
vTable.Cell(2, 6).Range.Text := rs.FieldByName('pages').Text; vTable.Cell(3, 2).Range.Text := rs.FieldByName('publish').Text;
vTable.Cell(3, 4).Range.Text := rs.FieldByName('zludate').Text;
vTable.Cell(4, 1).Range.Text := rs['content'];
rs.Next;
inc(j);
if rs.eof then
begin
application.ProcessMessages;
frm_wait.Label1.Caption:='正在生成word文件，请稍后...' ;
application.ProcessMessages;
end;
end;
笔者在实际应用中发现，报表的内容一般很少变动，但其字体格式及版式是经常变动的，而且有时用户为了某种需要，不想修改数据库的真实内容而又要改变报表内容。如果用ReportSmith可以解决前者问题，但对于后者则无能为力了，且其界面是英文的，不合用户习惯。如果用3.0中的TQReport的报表部件，则两者都不能实时解决，必须修改原代码后重新编译才能使用。而使用Word及Excel则完全可以克服以上不足。具体实现如下(以Word实现为例)：
首先用Word编辑报表格式，并排好版，把将要输出的数据项用表单域代替，并取名。这里我们暂时假设有表单域Item1及Item2(均为文本型),将这个文档存为模板文件Example.dot，然后按如下步骤进行： 1)运行Delphi3，在Form1里加入一个System部件集里的TDdeClientCov部件，取名为DdeExample,将其ConnectMode设为ddeManual(手动方式)；将DdeService设为‘(WinWord)’；将ServiceApplication设为‘WinWord’。 2)编写一个自定义过程，以激活Word，如下：
procedure Tform1.WordActive(Cmds: TStrings);
var
WordPath: String;
begin
if(not DdeExample.OpenLink) then {判断是否巳动态链接}
begin
if(FindWindow('OpusApp', nil)=0) then
begin
WordPath := 'C:msofficewinword';
if(WordPath=') then
ShowMessage('中文Word未安装或未设置路径，请安装设置Word中文 版。')
else begin
DdeExample.ServiceApplication := WordPath+'Winword.exe';
if(DdeExample.OpenLink) then {如果巳动态链接执行宏命令}
DdeExample.ExecuteMacroLines(Cmds,False)
else
ShowMessage('无法启动Word中文版!');
DdeExample.ServiceApplication := 'WinWord.exe';
end;
end
else begin{如果巳动态链接执行宏命令}
DdeExample.ExecuteMacroLines(Cmds,False);
end;
end
else
DdeExample.ExecuteMacroLines(Cmds,false);
end; 在private声明区里加入如下：
procedure ActiveWord(Cmds: TStrings); 3)在Form1中加入一个按钮Button1,在其onclick事件里写如下代码：
procedure TForm1.Button1Click(Sender: TObject);
var
Cmds:TStringList;{创建Cmds}
TempItem1,TempItem2:String;
begin
cmds:=TStringList.Create;
cmds.Clear;
TempItem1:='数据项一';
TempItem2:='数据项二';
with Cmds do
begin
Clear;
Add('[FileNew.Template ="Example.Dot″]');{打开模板文件Example.Dot}
Add('[AppMaximize]');{文档最大化}
Add('[SetFormResult"Item1″,″'+TempItem1+'″]');{将数据TempItem1传给表单域Item1}
Add('[SetFormResult"Item2″,″'+TempItem2+'″]);{将数据TempItem2传给表单域Item2}
end;
WordActive(DdeExample,Cmds);{调用自定义过程}
Cmds.Free;{释放Cmds}
end; 运行这个程序，单击Button1，大家可以发现Word被启动了，屏幕上出现了：数据项一;数据项二两个数据项。最后，大家可以任意修改本报表的格式及数据，因为这时这个报表与具体的应用程序巳没有关系了。 本例中用的是中文Word6或中文Word7。由于Word97的宏命令巳变为Visual Basic语句，如大家想用Word97实现，请将其宏命令改变为相应的代码。 这是个简单的示例，大家可以利用Word的宏录制功能，录取更多的宏(如自动生成表格、填充文字、变动字体等宏命令)，并与数据库的各种表联系起来，依次加入Cmds中即可实现您所要求的更复杂的功能。
选择空表-->复制---->粘贴--->填充上面的空表---->将操作点定位到刚才复制后的空表-->选择空表-->复制---->粘贴--->填充上面的空表.........如此循环，希望大家有收获