uses ..., ComObj, WordXP, Clipbrd, JPEG
procedure TFrm_Employee.DoExportWord(DeptNo: String; Conn: TADOConnection);
var
i:Integer;
EmpCount:integer;
StrDocTitle,StrDept:String;
wordApp:Variant; //ComObj单元(创建automation obj), WordXP单元(vba常量定义)
wordDoc:Variant;
wrdSelection:Variant;
Stream:TStream;
jpgimage:TJPEGImage; //JPEG 单元
MyFormat : Word; //剪贴板用到
AData: THandle;
APalette:HPalette;
begin
//连接已存在word application, 不然创建一个word app
try
wordApp:=GetActiveOleObject(‘Word.Application‘);
except
try
wordApp:=CreateOleObject(‘Word.Application‘);
except
Application.MessageBox(‘系统没有安装Microsoft Word, 不能导出!‘,‘错误‘);
exit;
end;
end;
wordApp.Visible:=true;
wordDoc:=wordApp.Documents.Add(); //创建一个word文档
wordDoc.Select;
wrdSelection:=wordApp.selection;
//查询数据库得到人员个数和部门名称
with TADOQuery.Create(nil) do
begin
Connection:=conn;
sql.Text:=‘select count(Dept) as empcount, max(dept) as dept from Employee where deptNo=:p1‘;
Parameters.ParamByName(‘p1‘).Value:=DeptNo;
open;
EmpCount:=Fields[0].AsInteger;
strDept :=Fields[1].AsString;
free;
end;
//在文档头插入标题并格式化字符
StrDocTitle:= ‘(‘ + DeptNo + ‘)‘ +strDept + ‘人员清单‘;
wrdSelection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
wrdSelection.font.bold:=true;
wrdSelection.font.size:=15;
wrdSelection.font.Underline:=1;
wrdSelection.TypeText(StrDocTitle);
wrdSelection.font.Underline:=0;
wrdSelection.font.bold:=false;
wrdSelection.font.size:=11;
wrdSelection.InsertAfter(#13);
//在文档中插入一个X行2列的表格,并格式化
wordDoc.Tables.Add(wrdSelection.Range,EmpCount,2,2,0); //五个参数分别为(const Range; NumRows; NumColumns; var DefaultTableBehavior, var DefaultFitBehavior)
wordDoc.Tables.Item(1).Borders.Item(1).LineStyle:=7; //item(1)表示第一个table, 也就是刚Add的Table
wordDoc.Tables.Item(1).Borders.Item(2).LineStyle:=7;
wordDoc.Tables.Item(1).Borders.Item(3).LineStyle:=7;
wordDoc.Tables.Item(1).Borders.Item(4).LineStyle:=7;
for i:=1 to EmpCount do
begin
//wordDoc.Tables.Item(1).Cell(i,1).Range.Bold:=true;
//wordDoc.Tables.Item(1).Cell(i,2).Range.Bold:=true;
//wordDoc.Tables.Item(1).Rows.Item(i).Range.Paragraphs.Alignment:=wdAlignParagraphCenter;
end;
//插入内容
jpgimage:=TJPEGImage.Create;
with TADOQuery.Create(nil) do
begin
Connection:=conn;
sql.Text:=‘select * from Employee where deptNo=:p1‘;
Parameters.ParamByName(‘p1‘).Value:=DeptNo;
open;
first;
i:=1;
while not eof do
begin
wordDoc.Tables.Item(1).Cell(i,1).Range.InsertAfter(‘工号:‘+ FieldByName(‘WorkNO‘).AsString + #13);
wordDoc.Tables.Item(1).Cell(i,1).Range.InsertAfter(‘姓名:‘+ FieldByName(‘Name‘).AsString + #13);
wordDoc.Tables.Item(1).Cell(i,1).Range.InsertAfter(‘部门:‘+ FieldByName(‘Dept‘).AsString + #13);
wordDoc.Tables.Item(1).Cell(i,1).Range.InsertAfter(‘职务:‘+ FieldByName(‘Title‘).AsString + #13);
wordDoc.Tables.Item(1).Cell(i,1).Range.InsertAfter(‘卡号:‘+ FieldByName(‘CardID‘).AsString + #13);
Stream:=TADOBlobStream.Create(TBlobField(FieldByName(‘Picture‘)),bmread);
if Stream.Size=0 then
begin
//没有照片
end
else
begin
jpgimage.LoadFromStream(Stream);
jpgimage.SaveToClipBoardFormat(MyFormat,AData,APalette);
ClipBoard.SetAsHandle(MyFormat,AData); //将AData复制到ClipBoard
worddoc.tables.item(1).cell(i,2).range.Paste;
end;
inc(i);
next;
end;
free; //TAdoqurey
end;
jpgImage.Free;
ForceDirectories(ExtractFilePath(Application.ExeName) + ‘\WORD导出\‘);
WordDoc.SaveAs(FileName:=ExtractFilePath(Application.ExeName)+ ‘\WORD导出\‘ + StrDocTitle + ‘.doc‘,FileFormat:=wdFormatDocument,
AddToRecentFiles:=False);
//WordDoc.SaveAs(FileName:=‘c:\aa.doc‘, FileFormat:= wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False);
WordDoc.Close; //关闭文档
WordApp.Quit; //退出word程序
end;
---------------------------------------------------
注意:
1.WordDoc.SaveAs函数有多个重载, 注释掉的一行saveas是用宏记录下来的,包含所有参数
也可以加一个server页中的wordDocument对象, 就可以看到代码提示了
2. saveas的参数表很怪, 这个叫named-argument
The ability to omit specifying arguments for parameters that have a default value is really taken advantage of by the Named arguments feature. This feature allows you to specify by name the parameter for which you are providing a value. This means that you can now omit specifying arguments for all parameters, and only specify the ones which you actually care about.
For COM programmers, this is like heaven! I recently "got" to play with Office interop a bit, and found that the average method had 30 parameters! Most of the parameters are wonderfully optional, and with the ability to now omit them, code looks much cleaner and is much more readable.
3.用InsertAfter可以写入回车#13, 而用text属性就不行:
wordDoc.Tables.Item(1).Cell(2,1).Range.InsertAfter(‘岗位级别‘);
wordDoc.Tables.Item(1).Cell(1,1).Range.text:=‘岗位名称‘+ #13; //出错:被呼叫方拒绝接受
4.在执行对word操作时就会不定时随机的出现‘被呼叫方拒绝接收呼叫‘,
后来发现金山词霸(包括google合作版)有冲突,关掉它就好了
也有人说和诺顿杀毒软件有冲突.