function ExportToWord(StrList: TStrings; SavePath: string): Boolean;
var
WordApp: TWordApplication;
WordDoc: TWordDocument;
Template, NewTemplate, DocumentTYpe, Visible: OleVariant;
ItemIndex: OleVariant;
FileName: OleVariant;
NoPrompt, OriginalFormat: OleVariant;
RouteDocument,SaveChanges:OleVariant;
LinkToFile, SaveWithDocument:OleVariant;
FilePath: string;
I: Integer;
begin
if FileExists(Savepath) then
Exit;
//连接到WORD 2000
try
WordApp := TWordApplication.Create(nil);
WordApp.Connect;
except
Application.MessageBox('不能生成文档,请确认是否安装了Word !', '提示', MB_ICONQUESTION);
Exit;
end;
//显示WORD
Template := EmptyParam;
NewTemplate := False;
DocumentTYpe := wdNewBlankDocument;
Visible := True;
//调用add函数
WordApp.Documents.Add(Template, NewTemplate, DocumentTYpe, Visible);
//连接到新建的文档
ItemIndex := 1;
WordDoc := TWordDocument.Create(nil);
WordDoc.ConnectTo(WordApp.Documents.Item(ItemIndex));
//文档另外为
FileName := SavePath;
WordDoc.SaveAs(FileName);
with WordApp.Selection do
begin
Font.Size := 20;
for I := 0 to StrList.Count - 1 do
begin
//对奇方式
Paragraphs.Alignment:=wdAlignParagraphCenter;
TypeText(StrList.Strings[i]);
TypeParagraph;//换行
//加载图片方式
//InlineShapes.AddPicture('C:\Documents and Settings\Administrator\桌面\695884_66_thumb.jpg',LinkToFile,SaveWithDocument,EmptyParam);
end;
end;
//保存文档
NoPrompt := False;
OriginalFormat := wdOriginalDocumentFormat;
WordApp.Documents.Save(NoPrompt, OriginalFormat);
//关闭文档
SaveChanges:=wdSaveChanges;
OriginalFormat:=wdOriginalDocumentFormat;
RouteDocument:=false;
WordApp.Documents.Close(SaveChanges,OriginalFormat,RouteDocument);
Worddoc.Disconnect ;
worddoc.Free;
//断开和Word 2000的连接
WordApp.Disconnect;
WordApp.Quit ;
WordApp.Free ;
MessageDlg('导出成功!保存为'+fileName,mtInformation,[mbOK],0);
FilePath := string(fileName);
ShellExecute(0, 'open', PChar(FilePath) , '', '',SW_SHOWNORMAL);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SaveName: string;
begin
Caption := ExtractFilePath(ParamStr(0));
SaveName := ExtractFilePath(ParamStr(0));
SaveName := SaveName + 'Test.Doc';
if FileExists(SaveName) then
DeleteFile(SaveName);
ShowMessage(SaveName);
ExportToWord(Memo1.Lines, SaveName);
end;