Ole操控word

在Delphi中使用CreateOleObject方法对WORD文件进行操作
使用CreateOleObject方法对WORD文档操作具有先天所具备的优势，与Delphi所提供的那些控件方式的访问相比，CreateOleObject方法距离WORD核心的操作“更近”，因为它直接使用Office所提供的VBA语言对WORD文档的操作进行编程。

以下是我在本机上所做的实验，机器软件配置如下：
Windows XP+delphi7.0+OFFICE 2003
这个程序很简单，在页面上放置了一个edit和一个button,每单击一次按钮，就会自动把edit中的内容添加在后台中的word文档中，程序关闭时文件自动保存在当前程序的主目录中。

******************************************************************************* unit main;
interface
//如果要使用CreateOleObject的办法对WORD文档进行操作，应该在uses
//语句中加入Comobj声明和WordXP声明
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Comobj, WordXP, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); // procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
//把这两个变量声明为全局变量
FWord: Variant;
FDoc: Variant;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
FWord.Selection.TypeParagraph;
FWord.Selection.TypeText(Text := form1.Edit1.Text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//首先创建对象，如果出现异常就作出提示
try
FWord := CreateOleObject('Word.Application');
//WORD程序的执行是否可见，值为False时程序在后台执行
FWord.Visible := False;
except
ShowMessage('创建word对象失败！');
Exit;
end;
//先在打开的Word中创建一个新的页面，然后在其中键入"Hello,"+回车＋"World！"
try
FDoc := FWord.Documents.Add;
FWord.Selection.TypeText(Text := 'Hello，' + #13);
FWord.Selection.TypeParagraph; //换行
FWord.Selection.TypeText(Text := 'World! ');
except
on e: Exception do
ShowMessage(e.Message);
end;
end;
//在程序关闭时把文件内容保存到当前目录中，并以test.doc命名
//同时关闭WORD程序
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FDoc.SaveAs(ExtractFilePath(application.ExeName) +'test.doc');
FWord.Quit;
FWord := Unassigned;
end;
end.
此外，对OFFICE其他文件的操作都比较类似，不在赘述。

通过对WORD文件中更复杂的VBA宏的引用，这个方法还可以完成更复杂的文档操作。

最近帮同学用Delphi 7写的一个数据库应用中的一个功能是将查询的结果
导出到一个Word文档中保存。

虽然Delphi 7的Servers面板中提供了TWordApplication和TWordDocument组件，但是帮助中却几乎没有写它们的使用方法。

于是在中国期刊网上down了许多的相关文章来看，只可惜几乎都是用Delphi 5写的（Delphi 7中不能兼容），而且都只是简单的介绍了一下，甚是郁闷。

在经过一天的摸索之后终于用Delphi 7实现了这个功能。

代码如下：
//uses Word2000, ComObj;
//WordApp: TWordApplication;
//WordDoc: TWordDocument;procedure TfrmDetails.btnExportClick(Sender: TObject); //单击“导出“按钮
var
V:Variant;
Template,NewTemplate,DocumentType,Visible:OleVariant;
itemIndex:OleVariant;
fileName:Olevariant;
NoPrompt,OriginalFormat:OleVariant;
RouteDocument,SaveChanges:OleVariant;
begin
//指定文档的路径和文件名
fileName:='C:/LogAdmin/doc/'+'值班日志'+Trim(DBTextID.Caption)+'.doc';
//如果该日志的对应Word文档已经存在则提示是否覆盖
if FileExists(fileName)=true then
begin
Beep;
if Application.MessageBox('文档已经存在，是否覆盖？','警告
',MB_OKCANCEL)=IDCANCEL then
Abort;
end;
//测试当前是否运行了Word 2000
try
V:=GetActiveOleObject('Word.Application');
except
//未运行则运行之
V:=CreateOleObject('Word.Basic');
end;
try
//连接到Word 2000
WordApp.Connect;
except
Beep;
MessageDlg('不能生成文档，请确认是否安装了Word 2000！
',mtError,[mbOK],0);
Abort;
end;
//显示Word 2000
WordApp.Visible:=true;
//给调用Add函数使用的实参赋值Template:=EmptyParam; NewTemplate:=False;
DocumentType:=wdNewBlankDocument;
Visible:=true;
//调用Add函数
WordApp.Documents.Add(Template,NewTemplate,DocumentType,Visible); //连接到新建的文档
itemIndex:=1;
WordDoc.ConnectTo(WordApp.Documents.Item(itemIndex));
//文档另存为
WordDoc.SaveAs(fileName);
//开始向Word文档中写入内容
with WordApp.Selection do
begin
Font.Size:=20;
Font.Bold:=2;
Paragraphs.Alignment:=wdAlignParagraphCenter; TypeText('值班日志详细内容'); TypeParagraph; //换行
TypeParagraph;
Font.Size:=12;
Font.Bold:=0;
Paragraphs.Alignment:=wdAlignParagraphLeft; TypeText('编号：'+DBTextID.Caption); TypeParagraph;
TypeText('日期：'+DBTextDate.Caption); TypeParagraph;
TypeText('温度：'+DBTextT.Caption); TypeParagraph;
TypeText('湿度：'+DBTextH.Caption); TypeParagraph;
TypeText('天气：'+DBTextWeather.Caption); TypeParagraph;
TypeText('值班人：'+DBTextName.Caption); TypeParagraph;
TypeText('值班时间：'+DBTextTime.Caption); TypeParagraph;
TypeText('有无异常：'+lbException.Caption); TypeParagraph;
TypeText('使用工具：');
Ty·moTool.Text);
TypeParagraph;
TypeText('现场环境：');
TypeParagraph;
TypeText(DBMemoEnv.Text);
TypeParagraph;
TypeText('记录一：');
TypeParagraph;
TypeText(DBMemoR1.Text);
TypeParagraph;
TypeText('记录二：');
TypeParagraph;
TypeText(DBMemoR2.Text);
TypeParagraph;
TypeText('记录三：');
TypeParagraph;
TypeText(DBMemoR3.Text);
TypeParagraph;
TypeText('备注：');
TypeParagraph;
TypeText(DBMemoMemo.Text);
TypeParagraph;
end;
//保存文档NoPrompt:=false;
OriginalFormat:=wdOriginalDocumentFormat;
WordApp.Documents.Save(NoPrompt,OriginalFormat);
//关闭文档
SaveChanges:=wdSaveChanges;
OriginalFormat:=wdOriginalDocumentFormat;
RouteDocument:=false;
WordApp.Documents.Close(SaveChanges,OriginalFormat,RouteDocument); //断开和Word 2000的连接WordApp.Disconnect;
MessageDlg('日志内容导出成功！保存为'+fileName,mtInformation,[mbOK],0); //关闭窗体
frmDetails.Close;
end;
function ReadPPt(sName: string): string;
var
n,m,i,j: integer;
PptApp: OleVariant;
begin
try
PptApp := CreateOleObject('PowerPoint.Application');
PptApp.Visible := true;
PptApp.Presentations.Open(sName);
n := PptApp.ActiveWindow.Presentation.Slides.Count;
for i:=1 to n do
begin
m := PptApp.ActiveWindow.Presentation.Slides.item(i).Shapes.Count;
for j:=1 to m do
begin
If
PptApp.ActiveWindow.Presentation.Slides.item(i).Shapes.item(j).HasTextFram e Then
result:=result+PptApp.ActiveWindow.Presentation.Slides.item(i).Shapes.item( j).TextFrame.TextRange.Text +#$D#$A;
end;
end;
finally
PptApp.ActiveWindow.Presentation.Saved := true;
PptApp.ActiveWindow.Close;
PptApp.Quit;
PptApp := null;
end;
end;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Comobj, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ppt,pst,wrd,doc: Variant;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
m,i,j: integer;
s: string;
begin
try
ppt:= CreateOleObject('PowerPoint.Application');
ppt.Visible:= True;
wrd:= CreateOleObject('Word.Application');
wrd.visible:= True;
except
ShowMessage('创建失败！');
try
pst:= ppt.Presentations.open('C:\ppt.ppt');
// pst:= ppt.Presentations.open('C:\T9.ppt');
doc:= wrd.Documents.Add;
except
ShowMessage('失败！');
end;
m:= pst.Slides.Count;
j:= 1;
for i:= 1 to m do
begin
if i>1 then
begin
if(pst.slides.item(i).Shapes.Title.TextFrame.TextRange.Text
= pst.slides.item(i-1).Shapes.Title.TextFrame.TextRange.Text) then
s:= s + pst.slides.item(i-1).Shapes.Title.TextFrame.TextRange.T ext+ #13;
end;
wrd.Selection.TypeText(T ext:= s);
{
if i=1 then
wrd.Selection.TypeText(Text:=
pst.slides.item(i).Shapes.Title.TextFrame.T extRange.Text + #13);
if i>1 then
begin
if(pst.slides.item(i).Shapes.Title.TextFrame.TextRange.Text
= pst.slides.item(i-1).Shapes.Title.TextFrame.TextRange.Text) then begin
inc(j);
wrd.Selection.TypeText(Text:=
pst.slides.item(i-1).Shapes.Title.TextFrame.T extRange.Text+ intT ostr(j) + #13);
end
else
begin
wrd.Selection.TypeText(Text:=
pst.slides.item(i).Shapes.Title.TextFrame.T extRange.Text + #13);
j:= 1;
end;
end;
}
pst.Saved:= True;
ppt.ActiveWindow.Close;
ppt.Quit;
ppt:= unAssigned;
doc.SaveAs(ExtractFilePath(Application.ExeName)+ 'ppta.doc');
wrd.Quit;
wrd:= unAssigned;
end;
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, Comobj, StdCtrls ;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
wod,doc: Variant;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
wod:= CreateOleobject('Word.Application');
wod.Visible:= True;
doc:= wod.Documents.Add;
wod.Selection.TypeText(Text:= '把这两个变量声明为全局变量' + #13);
wod.Selection.Typeparagraph;
wod.selection.TypeText(Text:= 'WORD程序的执行是否可见' + #13);
wod.selection.TypeText(Text:= 'Hello Word!');
doc.SaveAs(ExtractFilePath(Application.ExeName)+ 'text.doc');
wod.quit;
wod:= Unassigned;
end;
end.
[文档可能无法思考全面，请浏览后下载，另外祝您生活愉快，工作顺利，万事如意!]。